Updated org-drill to version 2.4.7.

contrib/lisp/org-drill.el

@@ -1,10 +1,28 @@
-;;; -*- coding: utf-8-unix -*-
+;; -*- 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.5
+;;; 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
 ;;; ========
@@ -31,6 +49,7 @@
 (require 'org)
 (require 'org-id)
 (require 'org-learn)
+(require 'savehist)
 
 
 (defgroup org-drill nil
@@ -203,6 +222,8 @@ during a drill session."
                     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
@@ -233,6 +254,23 @@ the hidden cloze during a test.")
   (org-drill--compute-cloze-keywords))
 
 
+;; Variables defining what keys can be pressed during drill sessions to quit the
+;; session, edit the item, etc.
+(defvar org-drill--quit-key ?q
+  "If this character is pressed during a drill session, quit the session.")
+(defvar org-drill--edit-key ?e
+  "If this character is pressed during a drill session, suspend the session
+with the cursor at the current item..")
+(defvar org-drill--help-key ??
+  "If this character is pressed during a drill session, show help.")
+(defvar org-drill--skip-key ?s
+  "If this character is pressed during a drill session, skip to the next
+item.")
+(defvar org-drill--tags-key ?t
+  "If this character is pressed during a drill session, edit the tags for
+the current item.")
+
+
 (defcustom org-drill-card-type-alist
   '((nil org-drill-present-simple-card)
     ("simple" org-drill-present-simple-card)
@@ -348,17 +386,38 @@ Available choices are:
 
 
 (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 (using the 'customize' facility) at the end of each
-drill session.
+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."
-  :group 'org-drill
-  :type 'sexp)
+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
@@ -979,7 +1038,7 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
       ;; 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-optimal-factor-matrix)
+            org-drill-sm5-optimal-factor-matrix)
     ;; else:
     (let* ((next-ef (modify-e-factor ef quality))
            (interval
@@ -1003,7 +1062,7 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
             (1+ n)
             next-ef
             failures meanq (1+ total-repeats)
-            org-drill-optimal-factor-matrix))))
+            org-drill-sm5-optimal-factor-matrix))))
 
 
 ;;; SM5 Algorithm =============================================================
@@ -1025,7 +1084,7 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
 
 (defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix)
   (let ((of (get-optimal-factor-sm5 n ef (or of-matrix
-                                             org-drill-optimal-factor-matrix))))
+                                             org-drill-sm5-optimal-factor-matrix))))
     (if (= 1 n)
         of
       (* of last-interval))))
@@ -1039,7 +1098,7 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
   (assert (> n 0))
   (assert (and (>= quality 0) (<= quality 5)))
   (unless of-matrix
-    (setq of-matrix org-drill-optimal-factor-matrix))
+    (setq of-matrix org-drill-sm5-optimal-factor-matrix))
   (setq of-matrix (cl-copy-tree of-matrix))
 
   (setq meanq (if meanq
@@ -1205,7 +1264,7 @@ 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-optimal-factor-matrix)
+        (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.
@@ -1244,7 +1303,7 @@ item will be scheduled exactly this many days into the future."
                                    total-repeats meanq ease)
 
         (if (eql 'sm5 org-drill-spaced-repetition-algorithm)
-            (setq org-drill-optimal-factor-matrix new-ofmatrix))
+            (setq org-drill-sm5-optimal-factor-matrix new-ofmatrix))
 
         (cond
          ((= 0 days-ahead)
@@ -1274,7 +1333,7 @@ of QUALITY."
             (sm5 (determine-next-interval-sm5 last-interval repetitions
                                               ease quality failures
                                               meanq total-repeats
-                                              org-drill-optimal-factor-matrix))
+                                              org-drill-sm5-optimal-factor-matrix))
             (sm2 (determine-next-interval-sm2 last-interval repetitions
                                               ease quality failures
                                               meanq total-repeats))
@@ -1304,11 +1363,19 @@ of QUALITY."
   "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)))
+        (next-review-dates (org-drill-hypothetical-next-review-dates))
+        (key-prompt (format "(0-5, %c=help, %c=edit, %c=tags, %c=quit)"
+                            org-drill--help-key
+                            org-drill--edit-key
+                            org-drill--tags-key
+                            org-drill--quit-key)))
     (save-excursion
-      (while (not (memq ch '(?q ?e ?0 ?1 ?2 ?3 ?4 ?5)))
+      (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 ??)
+                     (if (eq ch org-drill--help-key)
                          (format "0-2 Means you have forgotten the item.
 3-5 Means you have remembered the item.
 
@@ -1319,11 +1386,12 @@ of QUALITY."
 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? (0-5, ?=help, e=edit, t=tags, q=quit)"
+How well did you do? %s"
                                  (round (nth 3 next-review-dates))
                                  (round (nth 4 next-review-dates))
-                                 (round (nth 5 next-review-dates)))
-                       "How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)")))
+                                 (round (nth 5 next-review-dates))
+                                 key-prompt)
+                       (format "How well did you do? %s" key-prompt))))
         (cond
          ((stringp input)
           (setq ch (elt input 0)))
@@ -1340,7 +1408,7 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
           (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 ?t)
+        (if (eql ch org-drill--tags-key)
             (org-set-tags-command))))
     (cond
      ((and (>= ch ?0) (<= ch ?5))
@@ -1371,7 +1439,7 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
           (org-set-property "DRILL_LAST_REVIEWED"
                             (time-to-inactive-org-timestamp (current-time))))
         quality))
-     ((= ch ?e)
+     ((= ch org-drill--edit-key)
       'edit)
      (t
       nil))))
@@ -1442,8 +1510,12 @@ the current topic."
               (apply 'format
                      (first fmt-and-args)
                      (rest fmt-and-args))
-            (concat "Press key for answer, "
-                    "e=edit, t=tags, s=skip, q=quit."))))
+            (format (concat "Press key for answer, "
+                            "%c=edit, %c=tags, %c=skip, %c=quit.")
+                    org-drill--edit-key
+                    org-drill--tags-key
+                    org-drill--skip-key
+                    org-drill--quit-key))))
     (setq prompt
           (format "%s %s %s %s %s %s"
                   (propertize
@@ -1489,7 +1561,7 @@ 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 ?t))
+    (while (memq ch '(nil org-drill--tags-key))
       (setq ch nil)
       (while (not (input-pending-p))
         (let ((elapsed (time-subtract (current-time) item-start-time)))
@@ -1500,12 +1572,12 @@ Consider reformulating the item to make it easier to remember.\n"
           (sit-for 1)))
       (setq input (read-key-sequence nil))
       (if (stringp input) (setq ch (elt input 0)))
-      (if (eql ch ?t)
+      (if (eql ch org-drill--tags-key)
           (org-set-tags-command)))
     (case ch
-      (?q nil)
-      (?e 'edit)
-      (?s 'skip)
+      (org-drill--quit-key nil)
+      (org-drill--edit-key 'edit)
+      (org-drill--skip-key 'skip)
       (otherwise t))))
 
 
@@ -2517,11 +2589,55 @@ STATUS is one of the following values:
            (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)))))
+               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)
@@ -2597,48 +2713,7 @@ work correctly with older versions of org mode. Your org mode version (%s) appea
               (let ((org-trust-scanner-tags t)
                     (warned-about-id-creation nil))
                 (org-map-drill-entries
-                 (lambda ()
-                   (org-drill-progress-message
-                    (+ (length *org-drill-new-entries*)
-                       (length *org-drill-overdue-entries*)
-                       (length *org-drill-young-mature-entries*)
-                       (length *org-drill-old-mature-entries*)
-                       (length *org-drill-failed-entries*))
-                    (incf cnt))
-                   (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*))
-                         )))))
+                 'org-map-drill-entry-function
                  scope drill-match)
                 (org-drill-order-overdue-entries overdue-data)
                 (setq *org-drill-overdue-entry-count*
@@ -2681,9 +2756,7 @@ work correctly with older versions of org mode. Your org mode version (%s) appea
 
 
 (defun org-drill-save-optimal-factor-matrix ()
-  (message "Saving optimal factor matrix...")
-  (customize-save-variable 'org-drill-optimal-factor-matrix
-                           org-drill-optimal-factor-matrix))
+  (savehist-autosave))
 
 
 (defun org-drill-cram (&optional scope drill-match)
@@ -2794,7 +2867,6 @@ values as `org-drill-scope'."
     (add-to-list 'org-font-lock-extra-keywords
                  (first org-drill-cloze-keywords))))
 
-(add-hook 'org-font-lock-set-keywords-hook 'org-drill-add-cloze-fontification)
 
 ;; Can't add to org-mode-hook, because local variables won't have been loaded
 ;; yet.