summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2019-07-11 22:55:02 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2019-07-11 22:55:02 +0200
commit2c8e8b4a186473729b983318c2befc1732127165 (patch)
tree195f920e7b3a5e34f89f2b80f9811a1d30e98616
parent4e6222f1888e43075ada7a5cc44b7996b23ce5dc (diff)
downloadorg-mode-2c8e8b4a186473729b983318c2befc1732127165.tar.gz
contrib: Remove Org Drill
* contrib/README: * lisp/org.el (org-modules): Remove reference to Org Drill. contrib/lisp/org-drill.el: Remove file. Org Drill is now developed externally, and available through an ELPA (MELPA at this point).
-rw-r--r--contrib/README1
-rw-r--r--contrib/lisp/org-drill.el3416
-rw-r--r--etc/ORG-NEWS4
-rw-r--r--lisp/org.el1
4 files changed, 4 insertions, 3418 deletions
diff --git a/contrib/README b/contrib/README
index 73d8830..73b4552 100644
--- a/contrib/README
+++ b/contrib/README
@@ -22,7 +22,6 @@ org-colview-xemacs.el --- Column View in Org-mode, XEmacs-specific version
org-contacts.el --- Contacts management
org-contribdir.el --- Dummy file to mark the org contrib Lisp directory
org-depend.el --- TODO dependencies for Org-mode
-org-drill.el --- Self-testing with org-learn
org-effectiveness.el --- Measuring your personal effectiveness
org-element.el --- Parser and applications for Org syntax
org-eldoc.el --- Eldoc documentation for SRC blocks
diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el
deleted file mode 100644
index 1662ea0..0000000
--- a/contrib/lisp/org-drill.el
+++ /dev/null
@@ -1,3416 +0,0 @@
-;; -*- 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.4.7
-;;; 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 distaributed 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
-;;; ========
-;;;
-;;; Uses the SuperMemo spaced repetition algorithms to conduct interactive
-;;; "drill sessions", where the material to be remembered is presented to the
-;;; student in random order. The student rates his or her recall of each item,
-;;; and this information is used to schedule the item for later revision.
-;;;
-;;; Each drill session can be restricted to topics in the current buffer
-;;; (default), one or several files, all agenda files, or a subtree. A single
-;;; topic can also be drilled.
-;;;
-;;; Different "card types" can be defined, which present their information to
-;;; the student in different ways.
-;;;
-;;; See the file README.org for more detailed documentation.
-
-
-(eval-when-compile (require 'cl))
-(eval-when-compile (require 'hi-lock))
-(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-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)
- (list 1 'org-drill-visible-cloze-face nil)
- (list 2 'org-drill-visible-cloze-hint-face t)
- (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.")
-(defvar org-drill--pronounce-key ?p
- "If this character is pressed during a drill session, pronounce for
-the current item.")
-
-
-(defcustom org-drill-card-type-alist
- '((nil org-drill-present-simple-card)
- ("simple" org-drill-present-simple-card)
- ("twosided" org-drill-present-two-sided-card 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)
-
-(defcustom org-drill-entry-before-hook nil
- "A hook to run functions when every org-drill entry."
- :group 'org-drill
- :type 'hook)
-
-(defcustom org-drill-entry-after-hook nil
- "A hook to run functions when every org-drill entry."
- :group 'org-drill
- :type 'hook)
-
-(defcustom org-drill-auto-pronounce t
- "Auto pronounce org-drill word if non-nil."
- :group 'org-drill
- :type 'boolean
- :safe #'booleanp)
-
-(defcustom org-drill-pronounce-command (executable-find "espeak")
- "Org-drill pronounce command."
- :group 'org-drill
- :type 'string)
-
-(defcustom org-drill-pronounce-command-args
- (if (string= org-drill-pronounce-command "/usr/bin/espeak")
- "-v en")
- "Org-drill pronounce command arguments."
- :group 'org-drill
- :type 'string)
-
-
-(defvar drill-answer nil
- "Global variable that can be bound to a correct answer when an
-item is being presented. If this variable is non-nil, the default
-presentation function will show its value instead of the default
-behaviour of revealing the contents of the drilled item.
-
-This variable is useful for card types that compute their answers
--- for example, a card type that asks the student to translate a
-random number to another language. ")
-
-
-(defvar *org-drill-session-qualities* nil)
-(defvar *org-drill-start-time* 0)
-(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 (cl-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-tags nil t))))
-
-
-(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))))
-
-
-(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-tags nil t))))
-
-
-;; (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-sequence 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."
- (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-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))
- (key-prompt (format "(0-5, %c=help, %c=pronounce, %c=edit, %c=tags, %c=quit)"
- org-drill--help-key
- org-drill--pronounce-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 (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)
-
-How well did you do? %s"
- (round (nth 3 next-review-dates))
- (round (nth 4 next-review-dates))
- (round (nth 5 next-review-dates))
- key-prompt)
- (format "How well did you do? %s" key-prompt))
- (when (eq ch org-drill--pronounce-key)
- (org-drill-pronounce-word))))
- (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 (org-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 (org-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)))
- nil 'tree))
- (reverse drill-sections)))
-
-
-(defun org-drill-hide-all-subheadings-except (heading-list)
- (org-drill-hide-subheadings-if
- (lambda () (let ((drill-heading (org-get-heading t)))
- (not (member drill-heading heading-list))))))
-
-
-(defun org-drill-presentation-prompt (&rest fmt-and-args)
- (let* ((item-start-time (current-time))
- (input nil)
- (ch nil)
- (last-second 0)
- (mature-entry-count (+ (length *org-drill-young-mature-entries*)
- (length *org-drill-old-mature-entries*)
- (length *org-drill-overdue-entries*)))
- (status (first (org-drill-entry-status)))
- (prompt
- (if fmt-and-args
- (apply 'format
- (first fmt-and-args)
- (rest fmt-and-args))
- (format (concat "Press key for answer, "
- "%c=pronounce, %c=edit, %c=tags, %c=skip, %c=quit.")
- org-drill--pronounce-key
- org-drill--edit-key
- org-drill--tags-key
- org-drill--skip-key
- org-drill--quit-key))))
- (setq prompt
- (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))
- (if (and (eql 'warn org-drill-leech-method)
- (org-drill-entry-leech-p))
- (setq 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"))
- prompt)))
- (while (memq ch '(nil org-drill--tags-key org-drill--pronounce-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))
- prompt))
- (sit-for 1)))
- (setq input (read-key-sequence nil))
- (if (stringp input) (setq ch (elt input 0)))
- (if (eql ch org-drill--tags-key)
- (org-set-tags-command))
- (when (eq ch org-drill--pronounce-key)
- (org-drill-pronounce-word)))
- (case ch
- (org-drill--quit-key nil)
- (org-drill--edit-key 'edit)
- (org-drill--skip-key 'skip)
- (otherwise t))))
-
-
-(defun org-pos-in-regexp (pos regexp &optional nlines)
- (save-excursion
- (goto-char pos)
- (org-in-regexp regexp nlines)))
-
-
-(defun org-drill-hide-region (beg end &optional text)
- "Hide the buffer region between BEG and END with an 'invisible text'
-visual overlay, or with the string TEXT if it is supplied."
- (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)
- (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 (if (string-match-p (regexp-quote "...") hint) "[%s]" "[%s...]")
- hint))))))
-
-
-(defun org-drill-hide-cloze-hints ()
- (save-excursion
- (while (re-search-forward org-drill-cloze-regexp nil t)
- (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)
- (cond
- (drill-answer
- (with-replaced-entry-text
- (format "\nAnswer:\n\n %s\n" drill-answer)
- (prog1
- (funcall reschedule-fn)
- (setq drill-answer nil))))
- (t
- (org-drill-hide-subheadings-if 'org-drill-entry-p)
- (org-drill-unhide-clozed-text)
- (org-drill--show-latex-fragments)
- (ignore-errors
- (org-display-inline-images t))
- (org-cycle-hide-drawers 'all)
- (with-hidden-cloze-hints
- (funcall reschedule-fn)))))
-
-
-(defun org-drill--show-latex-fragments ()
- (org-clear-latex-preview)
- (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-pronounce-word ()
- "Pronounce word after querying."
- (interactive)
- (start-process-shell-command
- "org-drill pronounce"
- nil
- (concat org-drill-pronounce-command
- " " org-drill-pronounce-command-args " "
- (shell-quote-argument
- (substring-no-properties (org-get-heading t t t t))))))
-
-(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)))
- (when org-drill-auto-pronounce (org-drill-pronounce-word))
- (run-hook-with-args 'org-drill-entry-before-hook)
- (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))))))))
- (run-hook-with-args 'org-drill-entry-after-hook)
- (org-clear-latex-preview)))))))
-
-
-(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*)
- (>= (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)
- (cond
- ((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
- (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)"))
- (sit-for 0.5)
- (setq warned-about-id-creation t))
- (org-id-get-create) ; ensure drill entry has unique ID
- (destructuring-bind (status due age)
- (org-drill-entry-status)
- (case status
- (:unscheduled
- (incf *org-drill-dormant-entry-count*))
- ;; (:tomorrow
- ;; (incf *org-drill-dormant-entry-count*)
- ;; (incf *org-drill-due-tomorrow-count*))
- (:future
- (incf *org-drill-dormant-entry-count*)
- (if (eq -1 due)
- (incf *org-drill-due-tomorrow-count*)))
- (:new
- (push (point-marker) *org-drill-new-entries*))
- (:failed
- (push (point-marker) *org-drill-failed-entries*))
- (:young
- (push (point-marker) *org-drill-young-mature-entries*))
- (:overdue
- (push (list (point-marker) due age) overdue-data))
- (:old
- (push (point-marker) *org-drill-old-mature-entries*))
- )))))
-
-
-(defun org-drill (&optional scope drill-match resume-p)
- "Begin an interactive 'drill session'. The user is asked to
-review a series of topics (headers). Each topic is initially
-presented as a 'question', often with part of the topic content
-hidden. The user attempts to recall the hidden information or
-answer the question, then presses a key to reveal the answer. The
-user then rates his or her recall or performance on that
-topic. This rating information is used to reschedule the topic
-for future review.
-
-Org-drill proceeds by:
-
-- Finding all topics (headings) in SCOPE which have either been
- used and rescheduled before, or which have a tag that matches
- `org-drill-question-tag'.
-
-- All matching topics which are either unscheduled, or are
- scheduled for the current date or a date in the past, are
- considered to be candidates for the drill session.
-
-- If `org-drill-maximum-items-per-session' is set, a random
- subset of these topics is presented. Otherwise, all of the
- eligible topics will be presented.
-
-SCOPE determines the scope in which to search for
-questions. It accepts the same values as `org-drill-scope',
-which see.
-
-DRILL-MATCH, if supplied, is a string specifying a tags/property/
-todo query. Only items matching the query will be considered.
-It accepts the same values as `org-drill-match', which see.
-
-If RESUME-P is non-nil, resume a suspended drill session rather
-than starting a new one."
-
- (interactive)
- ;; Check org version. Org 7.9.3f introduced a backwards-incompatible change
- ;; to the arguments accepted by `org-schedule'. At the time of writing there
- ;; are still lots of people using versions of org older than this.
- (let ((majorv (first (mapcar 'string-to-number (split-string (org-release) "[.]")))))
- (if (and (< majorv 8)
- (not (string-match-p "universal prefix argument" (documentation 'org-schedule))))
- (read-char-exclusive
- (format "Warning: org-drill requires org mode 7.9.3f or newer. Scheduling of failed cards will not
-work correctly with older versions of org mode. Your org mode version (%s) appears to be older than
-7.9.3f. Please consider installing a more recent version of org mode." (org-release)))))
- (let ((end-pos nil)
- (overdue-data nil)
- (cnt 0))
- (block org-drill
- (unless resume-p
- (org-drill-free-markers t)
- (setq *org-drill-current-item* nil
- *org-drill-done-entries* nil
- *org-drill-dormant-entry-count* 0
- *org-drill-due-entry-count* 0
- *org-drill-due-tomorrow-count* 0
- *org-drill-overdue-entry-count* 0
- *org-drill-new-entries* nil
- *org-drill-overdue-entries* nil
- *org-drill-young-mature-entries* nil
- *org-drill-old-mature-entries* nil
- *org-drill-failed-entries* nil
- *org-drill-again-entries* nil)
- (setq *org-drill-session-qualities* nil)
- (setq *org-drill-start-time* (float-time (current-time))))
- (setq *random-state* (make-random-state t)) ; reseed RNG
- (unwind-protect
- (save-excursion
- (unless resume-p
- (let ((org-trust-scanner-tags t)
- (warned-about-id-creation nil))
- (org-map-drill-entries
- 'org-map-drill-entry-function
- scope drill-match)
- (org-drill-order-overdue-entries overdue-data)
- (setq *org-drill-overdue-entry-count*
- (length *org-drill-overdue-entries*))))
- (setq *org-drill-due-entry-count* (org-drill-pending-entry-count))
- (cond
- ((and (null *org-drill-current-item*)
- (null *org-drill-new-entries*)
- (null *org-drill-failed-entries*)
- (null *org-drill-overdue-entries*)
- (null *org-drill-young-mature-entries*)
- (null *org-drill-old-mature-entries*))
- (message "I did not find any pending drill items."))
- (t
- (org-drill-entries resume-p)
- (message "Drill session finished!"))))
- (progn
- (unless end-pos
- (setq *org-drill-cram-mode* nil)
- (org-drill-free-markers *org-drill-done-entries*)))))
- (cond
- (end-pos
- (when (markerp end-pos)
- (org-drill-goto-entry end-pos)
- (org-reveal)
- (org-show-entry))
- (let ((keystr (command-keybinding-to-string 'org-drill-resume)))
- (message
- "You can continue the drill session with the command `org-drill-resume'.%s"
- (if keystr (format "\nYou can run this command by pressing %s." keystr)
- ""))))
- (t
- (org-drill-final-report)
- (if (eql 'sm5 org-drill-spaced-repetition-algorithm)
- (org-drill-save-optimal-factor-matrix))
- (if org-drill-save-buffers-after-drill-sessions-p
- (save-some-buffers))
- (message "Drill session finished!")
- ))))
-
-
-(defun org-drill-save-optimal-factor-matrix ()
- (savehist-autosave))
-
-
-(defun org-drill-cram (&optional scope drill-match)
- "Run an interactive drill session in 'cram mode'. In cram mode,
-all drill items are considered to be due for review, unless they
-have been reviewed within the last `org-drill-cram-hours'
-hours."
- (interactive)
- (setq *org-drill-cram-mode* t)
- (org-drill scope drill-match))
-
-
-(defun org-drill-tree ()
- "Run an interactive drill session using drill items within the
-subtree at point."
- (interactive)
- (org-drill 'tree))
-
-
-(defun org-drill-directory ()
- "Run an interactive drill session using drill items from all org
-files in the same directory as the current file."
- (interactive)
- (org-drill 'directory))
-
-
-(defun org-drill-again (&optional scope drill-match)
- "Run a new drill session, but try to use leftover due items that
-were not reviewed during the last session, rather than scanning for
-unreviewed items. If there are no leftover items in memory, a full
-scan will be performed."
- (interactive)
- (setq *org-drill-cram-mode* nil)
- (cond
- ((plusp (org-drill-pending-entry-count))
- (org-drill-free-markers *org-drill-done-entries*)
- (if (markerp *org-drill-current-item*)
- (free-marker *org-drill-current-item*))
- (setq *org-drill-start-time* (float-time (current-time))
- *org-drill-done-entries* nil
- *org-drill-current-item* nil)
- (org-drill scope drill-match t))
- (t
- (org-drill scope drill-match))))
-
-
-
-(defun org-drill-resume ()
- "Resume a suspended drill session. Sessions are suspended by
-exiting them with the `edit' or `quit' options."
- (interactive)
- (cond
- ((org-drill-entries-pending-p)
- (org-drill nil nil t))
- ((and (plusp (org-drill-pending-entry-count))
- ;; Current drill session is finished, but there are still
- ;; more items which need to be reviewed.
- (y-or-n-p (format
- "You have finished the drill session. However, %d items still
-need reviewing. Start a new drill session? "
- (org-drill-pending-entry-count))))
- (org-drill-again))
- (t
- (message "You have finished the drill session."))))
-
-
-(defun org-drill-relearn-item ()
- "Make the current item due for revision, and set its last interval to 0.
-Makes the item behave as if it has been failed, without actually recording a
-failure. This command can be used to 'reset' repetitions for an item."
- (interactive)
- (org-drill-smart-reschedule 4 0))
-
-
-(defun org-drill-strip-entry-data ()
- (dolist (prop org-drill-scheduling-properties)
- (org-delete-property prop))
- (org-schedule '(4)))
-
-
-(defun org-drill-strip-all-data (&optional scope)
- "Delete scheduling data from every drill entry in scope. This
-function may be useful if you want to give your collection of
-entries to someone else. Scope defaults to the current buffer,
-and is specified by the argument SCOPE, which accepts the same
-values as `org-drill-scope'."
- (interactive)
- (when (yes-or-no-p
- "Delete scheduling data from ALL items in scope: are you sure?")
- (cond
- ((null scope)
- ;; Scope is the current buffer. This means we can use
- ;; `org-delete-property-globally', which is faster.
- (dolist (prop org-drill-scheduling-properties)
- (org-delete-property-globally prop))
- (org-map-drill-entries (lambda () (org-schedule '(4))) scope))
- (t
- (org-map-drill-entries 'org-drill-strip-entry-data scope)))
- (message "Done.")))
-
-
-(defun org-drill-add-cloze-fontification ()
- ;; Compute local versions of the regexp for cloze deletions, in case
- ;; the left and right delimiters are redefined locally.
- (setq-local org-drill-cloze-regexp (org-drill--compute-cloze-regexp))
- (setq-local org-drill-cloze-keywords (org-drill--compute-cloze-keywords))
- (when org-drill-use-visible-cloze-face-p
- (add-to-list 'org-font-lock-extra-keywords
- (first org-drill-cloze-keywords))))
-
-
-;; Can't add to org-mode-hook, because local variables won't have been loaded
-;; yet.
-
-;; (defun org-drill-add-cloze-fontification ()
-;; (when (eql major-mode 'org-mode)
-;; ;; Compute local versions of the regexp for cloze deletions, in case
-;; ;; the left and right delimiters are redefined locally.
-;; (setq-local org-drill-cloze-regexp (org-drill--compute-cloze-regexp))
-;; (setq-local org-drill-cloze-keywords (org-drill--compute-cloze-keywords))
-;; (when org-drill-use-visible-cloze-face-p
-;; (font-lock-add-keywords nil ;'org-mode
-;; org-drill-cloze-keywords
-;; nil))))
-
-;; XXX
-;; (add-hook 'hack-local-variables-hook
-;; 'org-drill-add-cloze-fontification)
-;;
-;; (org-drill-add-cloze-fontification)
-
-
-;;; Synching card collections =================================================
-
-
-(defvar *org-drill-dest-id-table* (make-hash-table :test 'equal))
-
-
-(defun org-drill-copy-entry-to-other-buffer (dest &optional path)
- "Copy the subtree at point to the buffer DEST. The copy will receive
-the tag 'imported'."
- (block org-drill-copy-entry-to-other-buffer
- (save-excursion
- (let ((src (current-buffer))
- (m nil))
- (cl-flet ((paste-tree-here (&optional level)
- (org-paste-subtree level)
- (org-drill-strip-entry-data)
- (org-toggle-tag "imported" 'on)
- (org-map-drill-entries
- (lambda ()
- (let ((id (org-id-get)))
- (org-drill-strip-entry-data)
- (unless (gethash id *org-drill-dest-id-table*)
- (puthash id (point-marker)
- *org-drill-dest-id-table*))))
- 'tree)))
- (unless path
- (setq path (org-get-outline-path)))
- (org-copy-subtree)
- (switch-to-buffer dest)
- (setq m
- (condition-case nil
- (org-find-olp path t)
- (error ; path does not exist in DEST
- (return-from org-drill-copy-entry-to-other-buffer
- (cond
- ((cdr path)
- (org-drill-copy-entry-to-other-buffer
- dest (butlast path)))
- (t
- ;; We've looked all the way up the path
- ;; Default to appending to the end of DEST
- (goto-char (point-max))
- (newline)
- (paste-tree-here)))))))
- (goto-char m)
- (outline-next-heading)
- (newline)
- (forward-line -1)
- (paste-tree-here (1+ (or (org-current-level) 0)))
- )))))
-
-
-
-(defun org-drill-merge-buffers (src &optional dest ignore-new-items-p)
- "SRC and DEST are two org mode buffers containing drill items.
-For each drill item in DEST that shares an ID with an item in SRC,
-overwrite scheduling data in DEST with data taken from the item in SRC.
-This is intended for use when two people are sharing a set of drill items,
-one person has made some updates to the item set, and the other person
-wants to migrate to the updated set without losing their scheduling data.
-
-By default, any drill items in SRC which do not exist in DEST are
-copied into DEST. We attempt to place the copied item in the
-equivalent location in DEST to its location in SRC, by matching
-the heading hierarchy. However if IGNORE-NEW-ITEMS-P is non-nil,
-we simply ignore any items that do not exist in DEST, and do not
-copy them across."
- (interactive "bImport scheduling info from which buffer?")
- (unless dest
- (setq dest (current-buffer)))
- (setq src (get-buffer src)
- dest (get-buffer dest))
- (when (yes-or-no-p
- (format
- (concat "About to overwrite all scheduling data for drill items in `%s' "
- "with information taken from matching items in `%s'. Proceed? ")
- (buffer-name dest) (buffer-name src)))
- ;; Compile list of all IDs in the destination buffer.
- (clrhash *org-drill-dest-id-table*)
- (with-current-buffer dest
- (org-map-drill-entries
- (lambda ()
- (let ((this-id (org-id-get)))
- (when this-id
- (puthash this-id (point-marker) *org-drill-dest-id-table*))))
- 'file))
- ;; Look through all entries in source buffer.
- (with-current-buffer src
- (org-map-drill-entries
- (lambda ()
- (let ((id (org-id-get))
- (last-quality nil) (last-reviewed nil)
- (scheduled-time nil))
- (cond
- ((or (null id)
- (not (org-drill-entry-p)))
- nil)
- ((gethash id *org-drill-dest-id-table*)
- ;; This entry matches an entry in dest. Retrieve all its
- ;; scheduling data, then go to the matching location in dest
- ;; and write the data.
- (let ((marker (gethash id *org-drill-dest-id-table*)))
- (destructuring-bind (last-interval repetitions failures
- total-repeats meanq ease)
- (org-drill-get-item-data)
- (setq last-reviewed (org-entry-get (point) "DRILL_LAST_REVIEWED")
- last-quality (org-entry-get (point) "DRILL_LAST_QUALITY")
- scheduled-time (org-get-scheduled-time (point)))
- (save-excursion
- ;; go to matching entry in destination buffer
- (switch-to-buffer (marker-buffer marker))
- (goto-char marker)
- (org-drill-strip-entry-data)
- (unless (zerop total-repeats)
- (org-drill-store-item-data last-interval repetitions failures
- total-repeats meanq ease)
- (if last-quality
- (org-set-property "LAST_QUALITY" last-quality)
- (org-delete-property "LAST_QUALITY"))
- (if last-reviewed
- (org-set-property "LAST_REVIEWED" last-reviewed)
- (org-delete-property "LAST_REVIEWED"))
- (if scheduled-time
- (org-schedule nil scheduled-time)))))
- (remhash id *org-drill-dest-id-table*)
- (free-marker marker)))
- (t
- ;; item in SRC has ID, but no matching ID in DEST.
- ;; It must be a new item that does not exist in DEST.
- ;; Copy the entire item to the *end* of DEST.
- (unless ignore-new-items-p
- (org-drill-copy-entry-to-other-buffer dest))))))
- 'file))
- ;; Finally: there may be some items in DEST which are not in SRC, and
- ;; which have been scheduled by another user of DEST. Clear out the
- ;; scheduling info from all the unmatched items in DEST.
- (with-current-buffer dest
- (maphash (lambda (id m)
- (goto-char m)
- (org-drill-strip-entry-data)
- (free-marker m))
- *org-drill-dest-id-table*))))
-
-
-
-;;; Card types for learning languages =========================================
-
-;;; Get spell-number.el from:
-;;; http://www.emacswiki.org/emacs/spell-number.el
-(autoload 'spelln-integer-in-words "spell-number")
-
-
-;;; `conjugate' card type =====================================================
-;;; See spanish.org for usage
-
-(defvar org-drill-verb-tense-alist
- '(("present" "tomato")
- ("simple present" "tomato")
- ("present indicative" "tomato")
- ;; past tenses
- ("past" "purple")
- ("simple past" "purple")
- ("preterite" "purple")
- ("imperfect" "darkturquoise")
- ("present perfect" "royalblue")
- ;; future tenses
- ("future" "green")
- ;; moods (backgrounds).
- ("indicative" nil) ; default
- ("subjunctive" "medium blue")
- ("conditional" "grey30")
- ("negative imperative" "red4")
- ("positive imperative" "darkgreen")
- )
- "Alist where each entry has the form (TENSE COLOUR), where
-TENSE is a string naming a tense in which verbs can be
-conjugated, and COLOUR is a string specifying a foreground colour
-which will be used by `org-drill-present-verb-conjugation' and
-`org-drill-show-answer-verb-conjugation' to fontify the verb and
-the name of the tense.")
-
-
-(defun org-drill-get-verb-conjugation-info ()
- "Auxiliary function used by `org-drill-present-verb-conjugation' and
-`org-drill-show-answer-verb-conjugation'."
- (let ((infinitive (org-entry-get (point) "VERB_INFINITIVE" t))
- (inf-hint (org-entry-get (point) "VERB_INFINITIVE_HINT" t))
- (translation (org-entry-get (point) "VERB_TRANSLATION" t))
- (tense (org-entry-get (point) "VERB_TENSE" nil))
- (mood (org-entry-get (point) "VERB_MOOD" nil))
- (highlight-face nil))
- (unless (and infinitive translation (or tense mood))
- (error "Missing information for verb conjugation card (%s, %s, %s, %s) at %s"
- infinitive translation tense mood (point)))
- (setq tense (if tense (downcase (car (read-from-string tense))))
- mood (if mood (downcase (car (read-from-string mood))))
- infinitive (car (read-from-string infinitive))
- inf-hint (if inf-hint (car (read-from-string inf-hint)))
- translation (car (read-from-string translation)))
- (setq highlight-face
- (list :foreground
- (or (second (assoc-string tense org-drill-verb-tense-alist t))
- "hotpink")
- :background
- (second (assoc-string mood org-drill-verb-tense-alist t))))
- (setq infinitive (propertize infinitive 'face highlight-face))
- (setq translation (propertize translation 'face highlight-face))
- (if tense (setq tense (propertize tense 'face highlight-face)))
- (if mood (setq mood (propertize mood 'face highlight-face)))
- (list infinitive inf-hint translation tense mood)))
-
-
-(defun org-drill-present-verb-conjugation ()
- "Present a drill entry whose card type is 'conjugate'."
- (cl-flet ((tense-and-mood-to-string
- (tense mood)
- (cond
- ((and tense mood)
- (format "%s tense, %s mood" tense mood))
- (tense
- (format "%s tense" tense))
- (mood
- (format "%s mood" mood)))))
- (destructuring-bind (infinitive inf-hint translation tense mood)
- (org-drill-get-verb-conjugation-info)
- (org-drill-present-card-using-text
- (cond
- ((zerop (random* 2))
- (format "\nTranslate the verb\n\n%s\n\nand conjugate for the %s.\n\n"
- infinitive (tense-and-mood-to-string tense mood)))
-
- (t
- (format "\nGive the verb that means\n\n%s %s\n
-and conjugate for the %s.\n\n"
- translation
- (if inf-hint (format " [HINT: %s]" inf-hint) "")
- (tense-and-mood-to-string tense mood))))))))
-
-
-(defun org-drill-show-answer-verb-conjugation (reschedule-fn)
- "Show the answer for a drill item whose card type is 'conjugate'.
-RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and
-returns its return value."
- (destructuring-bind (infinitive inf-hint translation tense mood)
- (org-drill-get-verb-conjugation-info)
- (with-replaced-entry-heading
- (format "%s of %s ==> %s\n\n"
- (capitalize
- (cond
- ((and tense mood)
- (format "%s tense, %s mood" tense mood))
- (tense
- (format "%s tense" tense))
- (mood
- (format "%s mood" mood))))
- infinitive translation)
- (org-cycle-hide-drawers 'all)
- (funcall reschedule-fn))))
-
-
-;;; `decline_noun' card type ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(defvar org-drill-noun-gender-alist
- '(("masculine" "dodgerblue")
- ("masc" "dodgerblue")
- ("male" "dodgerblue")
- ("m" "dodgerblue")
- ("feminine" "orchid")
- ("fem" "orchid")
- ("female" "orchid")
- ("f" "orchid")
- ("neuter" "green")
- ("neutral" "green")
- ("neut" "green")
- ("n" "green")
- ))
-
-
-(defun org-drill-get-noun-info ()
- "Auxiliary function used by `org-drill-present-noun-declension' and
-`org-drill-show-answer-noun-declension'."
- (let ((noun (org-entry-get (point) "NOUN" t))
- (noun-hint (org-entry-get (point) "NOUN_HINT" t))
- (noun-root (org-entry-get (point) "NOUN_ROOT" t))
- (noun-gender (org-entry-get (point) "NOUN_GENDER" t))
- (translation (org-entry-get (point) "NOUN_TRANSLATION" t))
- (highlight-face nil))
- (unless (and noun translation)
- (error "Missing information for `decline_noun' card (%s, %s, %s, %s) at %s"
- noun translation noun-hint noun-root (point)))
- (setq noun-root (if noun-root (car (read-from-string noun-root)))
- noun (car (read-from-string noun))
- noun-gender (downcase (car (read-from-string noun-gender)))
- noun-hint (if noun-hint (car (read-from-string noun-hint)))
- translation (car (read-from-string translation)))
- (setq highlight-face
- (list :foreground
- (or (second (assoc-string noun-gender
- org-drill-noun-gender-alist t))
- "red")))
- (setq noun (propertize noun 'face highlight-face))
- (setq translation (propertize translation 'face highlight-face))
- (list noun noun-root noun-gender noun-hint translation)))
-
-
-(defun org-drill-present-noun-declension ()
- "Present a drill entry whose card type is 'decline_noun'."
- (destructuring-bind (noun noun-root noun-gender noun-hint translation)
- (org-drill-get-noun-info)
- (let* ((props (org-entry-properties (point)))
- (definite
- (cond
- ((assoc "DECLINE_DEFINITE" props)
- (propertize (if (org-entry-get (point) "DECLINE_DEFINITE")
- "definite" "indefinite")
- 'face 'warning))
- (t nil)))
- (plural
- (cond
- ((assoc "DECLINE_PLURAL" props)
- (propertize (if (org-entry-get (point) "DECLINE_PLURAL")
- "plural" "singular")
- 'face 'warning))
- (t nil))))
- (org-drill-present-card-using-text
- (cond
- ((zerop (random* 2))
- (format "\nTranslate the noun\n\n%s (%s)\n\nand list its declensions%s.\n\n"
- noun noun-gender
- (if (or plural definite)
- (format " for the %s %s form" definite plural)
- "")))
- (t
- (format "\nGive the noun that means\n\n%s %s\n
-and list its declensions%s.\n\n"
- translation
- (if noun-hint (format " [HINT: %s]" noun-hint) "")
- (if (or plural definite)
- (format " for the %s %s form" definite plural)
- ""))))))))
-
-
-(defun org-drill-show-answer-noun-declension (reschedule-fn)
- "Show the answer for a drill item whose card type is 'decline_noun'.
-RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and
-returns its return value."
- (destructuring-bind (noun noun-root noun-gender noun-hint translation)
- (org-drill-get-noun-info)
- (with-replaced-entry-heading
- (format "Declensions of %s (%s) ==> %s\n\n"
- noun noun-gender translation)
- (org-cycle-hide-drawers 'all)
- (funcall reschedule-fn))))
-
-
-;;; `translate_number' card type ==============================================
-;;; See spanish.org for usage
-
-
-(defun spelln-integer-in-language (n lang)
- (let ((spelln-language lang))
- (spelln-integer-in-words n)))
-
-(defun org-drill-present-translate-number ()
- (let ((num-min (read (org-entry-get (point) "DRILL_NUMBER_MIN")))
- (num-max (read (org-entry-get (point) "DRILL_NUMBER_MAX")))
- (language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
- (drilled-number 0)
- (drilled-number-direction 'to-english)
- (highlight-face 'font-lock-warning-face))
- (cond
- ((not (fboundp 'spelln-integer-in-words))
- (message "`spell-number.el' not loaded, skipping 'translate_number' card...")
- (sit-for 0.5)
- 'skip)
- ((not (and (numberp num-min) (numberp num-max) language))
- (error "Missing language or minimum or maximum numbers for number card"))
- (t
- (if (> num-min num-max)
- (psetf num-min num-max
- num-max num-min))
- (setq drilled-number
- (+ num-min (random* (abs (1+ (- num-max num-min))))))
- (setq drilled-number-direction
- (if (zerop (random* 2)) 'from-english 'to-english))
- (cond
- ((eql 'to-english drilled-number-direction)
- (org-drill-present-card-using-text
- (format "\nTranslate into English:\n\n%s\n"
- (propertize
- (spelln-integer-in-language drilled-number language)
- 'face highlight-face))
- (spelln-integer-in-language drilled-number 'english-gb)))
- (t
- (org-drill-present-card-using-text
- (format "\nTranslate into %s:\n\n%s\n"
- (capitalize (format "%s" language))
- (propertize
- (spelln-integer-in-language drilled-number 'english-gb)
- 'face highlight-face))
- (spelln-integer-in-language drilled-number language))))))))
-
-
-;; (defun org-drill-show-answer-translate-number (reschedule-fn)
-;; (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
-;; (highlight-face 'font-lock-warning-face)
-;; (non-english
-;; (let ((spelln-language language))
-;; (propertize (spelln-integer-in-words *drilled-number*)
-;; 'face highlight-face)))
-;; (english
-;; (let ((spelln-language 'english-gb))
-;; (propertize (spelln-integer-in-words *drilled-number*)
-;; 'face 'highlight-face))))
-;; (with-replaced-entry-text
-;; (cond
-;; ((eql 'to-english *drilled-number-direction*)
-;; (format "\nThe English translation of %s is:\n\n%s\n"
-;; non-english english))
-;; (t
-;; (format "\nThe %s translation of %s is:\n\n%s\n"
-;; (capitalize (format "%s" language))
-;; english non-english)))
-;; (funcall reschedule-fn))))
-
-
-;;; `spanish_verb' card type ==================================================
-;;; Not very interesting, but included to demonstrate how a presentation
-;;; function can manipulate which subheading are hidden versus shown.
-
-
-(defun org-drill-present-spanish-verb ()
- (let ((prompt nil)
- (reveal-headings nil))
- (with-hidden-comments
- (with-hidden-cloze-hints
- (with-hidden-cloze-text
- (case (random* 6)
- (0
- (org-drill-hide-all-subheadings-except '("Infinitive"))
- (setq prompt
- (concat "Translate this Spanish verb, and conjugate it "
- "for the *present* tense.")
- reveal-headings '("English" "Present Tense" "Notes")))
- (1
- (org-drill-hide-all-subheadings-except '("English"))
- (setq prompt (concat "For the *present* tense, conjugate the "
- "Spanish translation of this English verb.")
- reveal-headings '("Infinitive" "Present Tense" "Notes")))
- (2
- (org-drill-hide-all-subheadings-except '("Infinitive"))
- (setq prompt (concat "Translate this Spanish verb, and "
- "conjugate it for the *past* tense.")
- reveal-headings '("English" "Past Tense" "Notes")))
- (3
- (org-drill-hide-all-subheadings-except '("English"))
- (setq prompt (concat "For the *past* tense, conjugate the "
- "Spanish translation of this English verb.")
- reveal-headings '("Infinitive" "Past Tense" "Notes")))
- (4
- (org-drill-hide-all-subheadings-except '("Infinitive"))
- (setq prompt (concat "Translate this Spanish verb, and "
- "conjugate it for the *future perfect* tense.")
- reveal-headings '("English" "Future Perfect Tense" "Notes")))
- (5
- (org-drill-hide-all-subheadings-except '("English"))
- (setq prompt (concat "For the *future perfect* tense, conjugate the "
- "Spanish translation of this English verb.")
- reveal-headings '("Infinitive" "Future Perfect Tense" "Notes"))))
- (org-cycle-hide-drawers 'all)
- (prog1 (org-drill-presentation-prompt)
- (org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
-
-
-(provide 'org-drill)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index bbd9dc9..8c90ffe 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -330,6 +330,10 @@ dynamic block in ~org-dynamic-block-alist~.
*** ~org-table-cell-right~
*** ~org-habit-toggle-display-in-agenda~
** Removed functions
+*** Removed Org Drill
+
+You can install it back from MELPA.
+
*** ~org-babel-set-current-result-hash~
*** ~org-capture-insert-template-here~
*** ~org-attach-directory~
diff --git a/lisp/org.el b/lisp/org.el
index 5d6cc75..8144d3b 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -708,7 +708,6 @@ For export specific modules, see also `org-export-backends'."
(const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
(const :tag "C collector: Collect properties into tables" org-collector)
(const :tag "C depend: TODO dependencies for Org mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
- (const :tag "C drill: Flashcards and spaced repetition for Org mode" org-drill)
(const :tag "C elisp-symbol: Links to emacs-lisp symbols" ol-elisp-symbol)
(const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light)
(const :tag "C eval: Include command output as text" org-eval)