|
@@ -2,7 +2,7 @@
|
|
|
;;; org-drill.el - Self-testing using spaced repetition
|
|
|
;;;
|
|
|
;;; Author: Paul Sexton <eeeickythump@gmail.com>
|
|
|
-;;; Version: 2.3.6
|
|
|
+;;; Version: 2.3.7
|
|
|
;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
|
|
|
;;;
|
|
|
;;;
|
|
@@ -188,11 +188,16 @@ during a drill session."
|
|
|
window t))
|
|
|
|
|
|
|
|
|
+(defvar org-drill-hint-separator "||"
|
|
|
+ "String which, if it occurs within a cloze expression, signifies that the
|
|
|
+rest of the expression after the string is a `hint', to be displayed instead of
|
|
|
+the hidden cloze during a test.")
|
|
|
+
|
|
|
+
|
|
|
(defvar org-drill-cloze-regexp
|
|
|
- ;; ver 1 "[^][]\\(\\[[^][][^]]*\\]\\)"
|
|
|
- ;; ver 2 "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)"
|
|
|
- ;; ver 3! "\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)"
|
|
|
- "\\(\\[[[:cntrl:][:graph:][:space:]]*?\\)\\(\\||.+?\\)\\(\\]\\)")
|
|
|
+ (concat "\\(\\[[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|"
|
|
|
+ (regexp-quote org-drill-hint-separator)
|
|
|
+ ".+?\\)\\(\\]\\)"))
|
|
|
|
|
|
|
|
|
(defvar org-drill-cloze-keywords
|
|
@@ -204,39 +209,51 @@ during a drill session."
|
|
|
|
|
|
|
|
|
(defcustom org-drill-card-type-alist
|
|
|
- '((nil . org-drill-present-simple-card)
|
|
|
- ("simple" . org-drill-present-simple-card)
|
|
|
- ("twosided" . org-drill-present-two-sided-card)
|
|
|
- ("multisided" . org-drill-present-multi-sided-card)
|
|
|
- ("hide1cloze" . org-drill-present-multicloze-hide1)
|
|
|
- ("hide2cloze" . org-drill-present-multicloze-hide2)
|
|
|
- ("show1cloze" . org-drill-present-multicloze-show1)
|
|
|
- ("show2cloze" . org-drill-present-multicloze-show2)
|
|
|
- ("multicloze" . org-drill-present-multicloze-hide1)
|
|
|
- ("hidefirst" . org-drill-present-multicloze-hide-first)
|
|
|
- ("hidelast" . org-drill-present-multicloze-hide-last)
|
|
|
- ("hide1_firstmore" . org-drill-present-multicloze-hide1-firstmore)
|
|
|
- ("show1_lastmore" . org-drill-present-multicloze-show1-lastmore)
|
|
|
- ("show1_firstless" . org-drill-present-multicloze-show1-firstless)
|
|
|
- ("conjugate" org-drill-present-verb-conjugation
|
|
|
+ '((nil org-drill-present-simple-card)
|
|
|
+ ("simple" org-drill-present-simple-card)
|
|
|
+ ("twosided" org-drill-present-two-sided-card nil t)
|
|
|
+ ("multisided" org-drill-present-multi-sided-card nil t)
|
|
|
+ ("hide1cloze" org-drill-present-multicloze-hide1)
|
|
|
+ ("hide2cloze" org-drill-present-multicloze-hide2)
|
|
|
+ ("show1cloze" org-drill-present-multicloze-show1)
|
|
|
+ ("show2cloze" org-drill-present-multicloze-show2)
|
|
|
+ ("multicloze" org-drill-present-multicloze-hide1)
|
|
|
+ ("hidefirst" org-drill-present-multicloze-hide-first)
|
|
|
+ ("hidelast" org-drill-present-multicloze-hide-last)
|
|
|
+ ("hide1_firstmore" org-drill-present-multicloze-hide1-firstmore)
|
|
|
+ ("show1_lastmore" org-drill-present-multicloze-show1-lastmore)
|
|
|
+ ("show1_firstless" org-drill-present-multicloze-show1-firstless)
|
|
|
+ ("conjugate"
|
|
|
+ org-drill-present-verb-conjugation
|
|
|
org-drill-show-answer-verb-conjugation)
|
|
|
- ("spanish_verb" . org-drill-present-spanish-verb)
|
|
|
- ("translate_number" org-drill-present-translate-number
|
|
|
- org-drill-show-answer-translate-number))
|
|
|
- "Alist associating card types with presentation functions. Each entry in the
|
|
|
-alist takes one of two forms:
|
|
|
-1. (CARDTYPE . QUESTION-FN), where CARDTYPE is a string or nil (for default),
|
|
|
- and QUESTION-FN is a function which takes no arguments and returns a boolean
|
|
|
- value.
|
|
|
-2. (CARDTYPE QUESTION-FN ANSWER-FN), where ANSWER-FN is a function that takes
|
|
|
- one argument -- the argument is a function that itself takes no arguments.
|
|
|
- ANSWER-FN is called with the point on the active item's
|
|
|
- heading, just prior to displaying the item's 'answer'. It can therefore be
|
|
|
- used to modify the appearance of the answer. ANSWER-FN must call its argument
|
|
|
- before returning. (Its argument is a function that prompts the user and
|
|
|
- performs rescheduling)."
|
|
|
+ ("decline_noun"
|
|
|
+ org-drill-present-noun-declension
|
|
|
+ org-drill-show-answer-noun-declension)
|
|
|
+ ("spanish_verb" org-drill-present-spanish-verb)
|
|
|
+ ("translate_number" org-drill-present-translate-number))
|
|
|
+ "Alist associating card types with presentation functions. Each
|
|
|
+entry in the alist takes the form:
|
|
|
+
|
|
|
+;;; (CARDTYPE QUESTION-FN [ANSWER-FN DRILL-EMPTY-P])
|
|
|
+
|
|
|
+Where CARDTYPE is a string or nil (for default), and QUESTION-FN
|
|
|
+is a function which takes no arguments and returns a boolean
|
|
|
+value.
|
|
|
+
|
|
|
+When supplied, ANSWER-FN is a function that takes one argument --
|
|
|
+that argument is a function of no arguments, which when called,
|
|
|
+prompts the user to rate their recall and performs rescheduling
|
|
|
+of the drill item. ANSWER-FN is called with the point on the
|
|
|
+active item's heading, just prior to displaying the item's
|
|
|
+'answer'. It can therefore be used to modify the appearance of
|
|
|
+the answer. ANSWER-FN must call its argument before returning.
|
|
|
+
|
|
|
+When supplied, DRILL-EMPTY-P is a boolean value, default nil.
|
|
|
+When non-nil, cards of this type will be presented during tests
|
|
|
+even if their bodies are empty."
|
|
|
:group 'org-drill
|
|
|
- :type '(alist :key-type (choice string (const nil)) :value-type function))
|
|
|
+ :type '(alist :key-type (choice string (const nil))
|
|
|
+ :value-type function))
|
|
|
|
|
|
|
|
|
(defcustom org-drill-scope
|
|
@@ -419,6 +436,17 @@ exponential effect on inter-repetition spacing."
|
|
|
:type 'float)
|
|
|
|
|
|
|
|
|
+(defvar drill-answer nil
|
|
|
+ "Global variable that can be bound to a correct answer when an
|
|
|
+item is being presented. If this variable is non-nil, the default
|
|
|
+presentation function will show its value instead of the default
|
|
|
+behaviour of revealing the contents of the drilled item.
|
|
|
+
|
|
|
+This variable is useful for card types that compute their answers
|
|
|
+-- for example, a card type that asks the student to translate a
|
|
|
+random number to another language. ")
|
|
|
+
|
|
|
+
|
|
|
(defvar *org-drill-session-qualities* nil)
|
|
|
(defvar *org-drill-start-time* 0)
|
|
|
(defvar *org-drill-new-entries* nil)
|
|
@@ -1261,28 +1289,29 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
|
|
|
((and (>= ch ?0) (<= ch ?5))
|
|
|
(let ((quality (- ch ?0))
|
|
|
(failures (org-drill-entry-failure-count)))
|
|
|
- (save-excursion
|
|
|
- (org-drill-smart-reschedule quality
|
|
|
- (nth quality next-review-dates)))
|
|
|
- (push quality *org-drill-session-qualities*)
|
|
|
- (cond
|
|
|
- ((<= quality org-drill-failure-quality)
|
|
|
- (when org-drill-leech-failure-threshold
|
|
|
- ;;(setq failures (if failures (string-to-number failures) 0))
|
|
|
- ;; (org-set-property "DRILL_FAILURE_COUNT"
|
|
|
- ;; (format "%d" (1+ failures)))
|
|
|
- (if (> (1+ failures) org-drill-leech-failure-threshold)
|
|
|
- (org-toggle-tag "leech" 'on))))
|
|
|
- (t
|
|
|
- (let ((scheduled-time (org-get-scheduled-time (point))))
|
|
|
- (when scheduled-time
|
|
|
- (message "Next review in %d days"
|
|
|
- (- (time-to-days scheduled-time)
|
|
|
- (time-to-days (current-time))))
|
|
|
- (sit-for 0.5)))))
|
|
|
- (org-set-property "DRILL_LAST_QUALITY" (format "%d" quality))
|
|
|
- (org-set-property "DRILL_LAST_REVIEWED"
|
|
|
- (time-to-inactive-org-timestamp (current-time)))
|
|
|
+ (unless *org-drill-cram-mode*
|
|
|
+ (save-excursion
|
|
|
+ (org-drill-smart-reschedule quality
|
|
|
+ (nth quality next-review-dates)))
|
|
|
+ (push quality *org-drill-session-qualities*)
|
|
|
+ (cond
|
|
|
+ ((<= quality org-drill-failure-quality)
|
|
|
+ (when org-drill-leech-failure-threshold
|
|
|
+ ;;(setq failures (if failures (string-to-number failures) 0))
|
|
|
+ ;; (org-set-property "DRILL_FAILURE_COUNT"
|
|
|
+ ;; (format "%d" (1+ failures)))
|
|
|
+ (if (> (1+ failures) org-drill-leech-failure-threshold)
|
|
|
+ (org-toggle-tag "leech" 'on))))
|
|
|
+ (t
|
|
|
+ (let ((scheduled-time (org-get-scheduled-time (point))))
|
|
|
+ (when scheduled-time
|
|
|
+ (message "Next review in %d days"
|
|
|
+ (- (time-to-days scheduled-time)
|
|
|
+ (time-to-days (current-time))))
|
|
|
+ (sit-for 0.5)))))
|
|
|
+ (org-set-property "DRILL_LAST_QUALITY" (format "%d" quality))
|
|
|
+ (org-set-property "DRILL_LAST_REVIEWED"
|
|
|
+ (time-to-inactive-org-timestamp (current-time))))
|
|
|
quality))
|
|
|
((= ch ?e)
|
|
|
'edit)
|
|
@@ -1361,9 +1390,13 @@ the current topic."
|
|
|
(format "%s %s %s %s %s %s"
|
|
|
(propertize
|
|
|
(char-to-string
|
|
|
- (case status
|
|
|
- (:new ?N) (:young ?Y) (:old ?o) (:overdue ?!)
|
|
|
- (:failed ?F) (t ??)))
|
|
|
+ (cond
|
|
|
+ ((eql status :failed) ?F)
|
|
|
+ (*org-drill-cram-mode* ?C)
|
|
|
+ (t
|
|
|
+ (case status
|
|
|
+ (:new ?N) (:young ?Y) (:old ?o) (:overdue ?!)
|
|
|
+ (t ??)))))
|
|
|
'face `(:foreground
|
|
|
,(case status
|
|
|
(:new org-drill-new-count-color)
|
|
@@ -1438,7 +1471,7 @@ visual overlay, or with the string TEXT if it is supplied."
|
|
|
|
|
|
(defun org-drill-hide-heading-at-point (&optional text)
|
|
|
(unless (org-at-heading-p)
|
|
|
- (error "Point is not on a heading"))
|
|
|
+ (error "Point is not on a heading."))
|
|
|
(save-excursion
|
|
|
(let ((beg (point)))
|
|
|
(end-of-line)
|
|
@@ -1472,19 +1505,22 @@ visual overlay, or with the string TEXT if it is supplied."
|
|
|
|
|
|
(defun org-drill-hide-matched-cloze-text ()
|
|
|
"Hide the current match with a 'cloze' visual overlay."
|
|
|
- (let ((ovl (make-overlay (match-beginning 0) (match-end 0))))
|
|
|
+ (let ((ovl (make-overlay (match-beginning 0) (match-end 0)))
|
|
|
+ (hint-sep-pos (string-match-p (regexp-quote org-drill-hint-separator)
|
|
|
+ (match-string 0))))
|
|
|
(overlay-put ovl 'category
|
|
|
'org-drill-cloze-overlay-defaults)
|
|
|
- (when (find ?| (match-string 0))
|
|
|
+ (when (and hint-sep-pos
|
|
|
+ (> hint-sep-pos 1))
|
|
|
(let ((hint (substring-no-properties
|
|
|
(match-string 0)
|
|
|
- (1+ (position ?| (match-string 0)))
|
|
|
+ (+ hint-sep-pos (length org-drill-hint-separator))
|
|
|
(1- (length (match-string 0))))))
|
|
|
(overlay-put
|
|
|
ovl 'display
|
|
|
;; If hint is like `X...' then display [X...]
|
|
|
;; otherwise display [...X]
|
|
|
- (format (if (string-match-p "\\.\\.\\." hint) "[%s]" "[%s...]")
|
|
|
+ (format (if (string-match-p (regexp-quote "...") hint) "[%s]" "[%s...]")
|
|
|
hint))))))
|
|
|
|
|
|
|
|
@@ -1601,13 +1637,24 @@ Note: does not actually alter the item."
|
|
|
(substring-no-properties text))))
|
|
|
|
|
|
|
|
|
-(defun org-drill-entry-empty-p ()
|
|
|
- (zerop (length (org-drill-get-entry-text))))
|
|
|
+;; (defun org-entry-empty-p ()
|
|
|
+;; (zerop (length (org-drill-get-entry-text))))
|
|
|
+
|
|
|
+;; This version is about 5x faster than the old version, above.
|
|
|
+(defun org-entry-empty-p ()
|
|
|
+ (save-excursion
|
|
|
+ (org-back-to-heading t)
|
|
|
+ (let ((lim (save-excursion
|
|
|
+ (outline-next-heading) (point))))
|
|
|
+ (org-end-of-meta-data-and-drawers)
|
|
|
+ (or (>= (point) lim)
|
|
|
+ (null (re-search-forward "[[:graph:]]" lim t))))))
|
|
|
|
|
|
+(defun org-drill-entry-empty-p () (org-entry-empty-p))
|
|
|
|
|
|
|
|
|
;;; Presentation functions ====================================================
|
|
|
-
|
|
|
+;;
|
|
|
;; Each of these is called with point on topic heading. Each needs to show the
|
|
|
;; topic in the form of a 'question' or with some information 'hidden', as
|
|
|
;; appropriate for the card type. The user should then be prompted to press a
|
|
@@ -1628,12 +1675,21 @@ Note: does not actually alter the item."
|
|
|
|
|
|
|
|
|
(defun org-drill-present-default-answer (reschedule-fn)
|
|
|
- (org-drill-hide-subheadings-if 'org-drill-entry-p)
|
|
|
- (org-drill-unhide-clozed-text)
|
|
|
- (ignore-errors
|
|
|
- (org-display-inline-images t))
|
|
|
- (with-hidden-cloze-hints
|
|
|
- (funcall reschedule-fn)))
|
|
|
+ (cond
|
|
|
+ (drill-answer
|
|
|
+ (with-replaced-entry-text
|
|
|
+ (format "\nAnswer:\n\n %s\n" drill-answer)
|
|
|
+ (prog1
|
|
|
+ (funcall reschedule-fn)
|
|
|
+ (setq drill-answer nil))))
|
|
|
+ (t
|
|
|
+ (org-drill-hide-subheadings-if 'org-drill-entry-p)
|
|
|
+ (org-drill-unhide-clozed-text)
|
|
|
+ (ignore-errors
|
|
|
+ (org-display-inline-images t))
|
|
|
+ (org-cycle-hide-drawers 'all)
|
|
|
+ (with-hidden-cloze-hints
|
|
|
+ (funcall reschedule-fn)))))
|
|
|
|
|
|
|
|
|
(defun org-drill-present-two-sided-card ()
|
|
@@ -1949,10 +2005,12 @@ pieces rather than one."
|
|
|
|
|
|
|
|
|
(defun org-drill-present-card-using-text (question &optional answer)
|
|
|
- "Present the string QUESTION as the only visible content of the card."
|
|
|
+ "Present the string QUESTION as the only visible content of the card.
|
|
|
+If ANSWER is supplied, set the global variable `drill-answer' to its value."
|
|
|
+ (if answer (setq drill-answer answer))
|
|
|
(with-hidden-comments
|
|
|
(with-replaced-entry-text
|
|
|
- question
|
|
|
+ (concat "\n" question)
|
|
|
(org-drill-hide-all-subheadings-except nil)
|
|
|
(org-cycle-hide-drawers 'all)
|
|
|
(ignore-errors
|
|
@@ -1964,7 +2022,9 @@ pieces rather than one."
|
|
|
(defun org-drill-present-card-using-multiple-overlays (replacements &optional answer)
|
|
|
"TEXTS is a list of valid values for the 'display' text property.
|
|
|
Present these overlays, in sequence, as the only
|
|
|
-visible content of the card."
|
|
|
+visible content of the card.
|
|
|
+If ANSWER is supplied, set the global variable `drill-answer' to its value."
|
|
|
+ (if answer (setq drill-answer answer))
|
|
|
(with-hidden-comments
|
|
|
(with-replaced-entry-text-multi
|
|
|
replacements
|
|
@@ -1995,20 +2055,24 @@ See `org-drill' for more details."
|
|
|
;; (org-back-to-heading))
|
|
|
(let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
|
|
|
(answer-fn 'org-drill-present-default-answer)
|
|
|
+ (present-empty-cards nil)
|
|
|
(cont nil)
|
|
|
;; fontification functions in `outline-view-change-hook' can cause big
|
|
|
;; slowdowns, so we temporarily bind this variable to nil here.
|
|
|
(outline-view-change-hook nil))
|
|
|
+ (setq drill-answer nil)
|
|
|
(org-save-outline-visibility t
|
|
|
(save-restriction
|
|
|
(org-narrow-to-subtree)
|
|
|
(org-show-subtree)
|
|
|
(org-cycle-hide-drawers 'all)
|
|
|
|
|
|
- (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
|
|
|
+ (let ((presentation-fn
|
|
|
+ (cdr (assoc card-type org-drill-card-type-alist))))
|
|
|
(if (listp presentation-fn)
|
|
|
(psetq answer-fn (or (second presentation-fn)
|
|
|
'org-drill-present-default-answer)
|
|
|
+ present-empty-cards (third presentation-fn)
|
|
|
presentation-fn (first presentation-fn)))
|
|
|
(cond
|
|
|
((null presentation-fn)
|
|
@@ -2034,6 +2098,7 @@ See `org-drill' for more details."
|
|
|
|
|
|
(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*
|
|
@@ -2045,7 +2110,8 @@ See `org-drill' for more details."
|
|
|
|
|
|
|
|
|
(defun org-drill-pending-entry-count ()
|
|
|
- (+ (length *org-drill-new-entries*)
|
|
|
+ (+ (if (markerp *org-drill-current-item*) 1 0)
|
|
|
+ (length *org-drill-new-entries*)
|
|
|
(length *org-drill-failed-entries*)
|
|
|
(length *org-drill-young-mature-entries*)
|
|
|
(length *org-drill-old-mature-entries*)
|
|
@@ -2057,6 +2123,7 @@ See `org-drill' for more details."
|
|
|
"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))))
|
|
@@ -2066,6 +2133,7 @@ maximum duration."
|
|
|
"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)))
|
|
|
|
|
@@ -2157,6 +2225,7 @@ RESUMING-P is true if we are resuming a suspended drill session."
|
|
|
(setq end-pos (point-marker))
|
|
|
(return-from org-drill-entries nil))
|
|
|
((eql result 'skip)
|
|
|
+ (setq *org-drill-current-item* nil)
|
|
|
nil) ; skip this item
|
|
|
(t
|
|
|
(cond
|
|
@@ -2166,7 +2235,8 @@ RESUMING-P is true if we are resuming a suspended drill session."
|
|
|
(shuffle-list *org-drill-again-entries*)))
|
|
|
(push-end m *org-drill-again-entries*))
|
|
|
(t
|
|
|
- (push m *org-drill-done-entries*))))))))))))
|
|
|
+ (push m *org-drill-done-entries*)))
|
|
|
+ (setq *org-drill-current-item* nil))))))))))
|
|
|
|
|
|
|
|
|
|
|
@@ -2176,7 +2246,8 @@ RESUMING-P is true if we are resuming a suspended drill session."
|
|
|
(> qual org-drill-failure-quality))
|
|
|
*org-drill-session-qualities*))
|
|
|
(max 1 (length *org-drill-session-qualities*))))
|
|
|
- (prompt nil))
|
|
|
+ (prompt nil)
|
|
|
+ (max-mini-window-height 0.6))
|
|
|
(setq prompt
|
|
|
(format
|
|
|
"%d items reviewed. Session duration %s.
|
|
@@ -2305,8 +2376,14 @@ one of the following values:
|
|
|
(cond
|
|
|
((not (org-drill-entry-p))
|
|
|
nil)
|
|
|
- ((org-drill-entry-empty-p)
|
|
|
- nil) ; skip -- item body is empty
|
|
|
+ ((and (org-entry-empty-p)
|
|
|
+ (let* ((card-type (org-entry-get (point) "DRILL_CARD_TYPE" nil))
|
|
|
+ (dat (cdr (assoc card-type org-drill-card-type-alist))))
|
|
|
+ (or (null card-type)
|
|
|
+ (not (third dat)))))
|
|
|
+ ;; body is empty, and this is not a card type where empty bodies are
|
|
|
+ ;; meaningful, so skip it.
|
|
|
+ nil)
|
|
|
((null due) ; unscheduled - usually a skipped leech
|
|
|
:unscheduled)
|
|
|
;; ((eql -1 due)
|
|
@@ -2446,47 +2523,16 @@ than starting a new one."
|
|
|
(:overdue
|
|
|
(push (cons (point-marker) due) overdue-data))
|
|
|
(:old
|
|
|
- (push (point-marker) *org-drill-old-mature-entries*)))))))
|
|
|
+ (push (point-marker) *org-drill-old-mature-entries*))
|
|
|
+ )))))
|
|
|
scope)
|
|
|
- ;; (let ((due (org-drill-entry-days-overdue))
|
|
|
- ;; (last-int (org-drill-entry-last-interval 1)))
|
|
|
- ;; (cond
|
|
|
- ;; ((org-drill-entry-empty-p)
|
|
|
- ;; nil) ; skip -- item body is empty
|
|
|
- ;; ((or (null due) ; unscheduled - usually a skipped leech
|
|
|
- ;; (minusp due)) ; scheduled in the future
|
|
|
- ;; (incf *org-drill-dormant-entry-count*)
|
|
|
- ;; (if (eq -1 due)
|
|
|
- ;; (incf *org-drill-due-tomorrow-count*)))
|
|
|
- ;; ((org-drill-entry-new-p)
|
|
|
- ;; (push (point-marker) *org-drill-new-entries*))
|
|
|
- ;; ((<= (org-drill-entry-last-quality 9999)
|
|
|
- ;; org-drill-failure-quality)
|
|
|
- ;; ;; Mature entries that were failed last time are
|
|
|
- ;; ;; FAILED, regardless of how young, old or overdue
|
|
|
- ;; ;; they are.
|
|
|
- ;; (push (point-marker) *org-drill-failed-entries*))
|
|
|
- ;; ((org-drill-entry-overdue-p due last-int)
|
|
|
- ;; ;; Overdue status overrides young versus old
|
|
|
- ;; ;; distinction.
|
|
|
- ;; ;; Store marker + due, for sorting of overdue entries
|
|
|
- ;; (push (cons (point-marker) due) overdue-data))
|
|
|
- ;; ((<= (org-drill-entry-last-interval 9999)
|
|
|
- ;; org-drill-days-before-old)
|
|
|
- ;; ;; Item is 'young'.
|
|
|
- ;; (push (point-marker)
|
|
|
- ;; *org-drill-young-mature-entries*))
|
|
|
- ;; (t
|
|
|
- ;; (push (point-marker)
|
|
|
- ;; *org-drill-old-mature-entries*))))
|
|
|
- ;; Order 'overdue' items so that the most overdue will tend to
|
|
|
- ;; come up for review first, while keeping exact order random
|
|
|
(org-drill-order-overdue-entries overdue-data)
|
|
|
(setq *org-drill-overdue-entry-count*
|
|
|
(length *org-drill-overdue-entries*))))
|
|
|
(setq *org-drill-due-entry-count* (org-drill-pending-entry-count))
|
|
|
(cond
|
|
|
- ((and (null *org-drill-new-entries*)
|
|
|
+ ((and (null *org-drill-current-item*)
|
|
|
+ (null *org-drill-new-entries*)
|
|
|
(null *org-drill-failed-entries*)
|
|
|
(null *org-drill-overdue-entries*)
|
|
|
(null *org-drill-young-mature-entries*)
|
|
@@ -2497,6 +2543,7 @@ than starting a new one."
|
|
|
(message "Drill session finished!"))))
|
|
|
(progn
|
|
|
(unless end-pos
|
|
|
+ (setq *org-drill-cram-mode* nil)
|
|
|
(org-drill-free-markers *org-drill-done-entries*)))))
|
|
|
(cond
|
|
|
(end-pos
|
|
@@ -2531,8 +2578,8 @@ all drill items are considered to be due for review, unless they
|
|
|
have been reviewed within the last `org-drill-cram-hours'
|
|
|
hours."
|
|
|
(interactive)
|
|
|
- (let ((*org-drill-cram-mode* t))
|
|
|
- (org-drill scope)))
|
|
|
+ (setq *org-drill-cram-mode* t)
|
|
|
+ (org-drill scope))
|
|
|
|
|
|
|
|
|
(defun org-drill-tree ()
|
|
@@ -2555,6 +2602,7 @@ were not reviewed during the last session, rather than scanning for
|
|
|
unreviewed items. If there are no leftover items in memory, a full
|
|
|
scan will be performed."
|
|
|
(interactive)
|
|
|
+ (setq *org-drill-cram-mode* nil)
|
|
|
(cond
|
|
|
((plusp (org-drill-pending-entry-count))
|
|
|
(org-drill-free-markers *org-drill-done-entries*)
|
|
@@ -2883,19 +2931,120 @@ returns its return value."
|
|
|
(mood
|
|
|
(format "%s mood" mood))))
|
|
|
infinitive translation)
|
|
|
+ (org-cycle-hide-drawers 'all)
|
|
|
+ (funcall reschedule-fn))))
|
|
|
+
|
|
|
+
|
|
|
+;;; `decline_noun' card type ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
+
|
|
|
+
|
|
|
+(defvar org-drill-noun-gender-alist
|
|
|
+ '(("masculine" "dodgerblue")
|
|
|
+ ("masc" "dodgerblue")
|
|
|
+ ("male" "dodgerblue")
|
|
|
+ ("m" "dodgerblue")
|
|
|
+ ("feminine" "orchid")
|
|
|
+ ("fem" "orchid")
|
|
|
+ ("female" "orchid")
|
|
|
+ ("f" "orchid")
|
|
|
+ ("neuter" "green")
|
|
|
+ ("neutral" "green")
|
|
|
+ ("neut" "green")
|
|
|
+ ("n" "green")
|
|
|
+ ))
|
|
|
+
|
|
|
+
|
|
|
+(defun org-drill-get-noun-info ()
|
|
|
+ "Auxiliary function used by `org-drill-present-noun-declension' and
|
|
|
+`org-drill-show-answer-noun-declension'."
|
|
|
+ (let ((noun (org-entry-get (point) "NOUN" t))
|
|
|
+ (noun-hint (org-entry-get (point) "NOUN_HINT" t))
|
|
|
+ (noun-root (org-entry-get (point) "NOUN_ROOT" t))
|
|
|
+ (noun-gender (org-entry-get (point) "NOUN_GENDER" t))
|
|
|
+ (translation (org-entry-get (point) "NOUN_TRANSLATION" t))
|
|
|
+ (highlight-face nil))
|
|
|
+ (unless (and noun translation)
|
|
|
+ (error "Missing information for `decline_noun' card (%s, %s, %s, %s) at %s"
|
|
|
+ noun translation noun-hint noun-root (point)))
|
|
|
+ (setq noun-root (if noun-root (car (read-from-string noun-root)))
|
|
|
+ noun (car (read-from-string noun))
|
|
|
+ noun-gender (downcase (car (read-from-string noun-gender)))
|
|
|
+ noun-hint (if noun-hint (car (read-from-string noun-hint)))
|
|
|
+ translation (car (read-from-string translation)))
|
|
|
+ (setq highlight-face
|
|
|
+ (list :foreground
|
|
|
+ (or (second (assoc-string noun-gender
|
|
|
+ org-drill-noun-gender-alist t))
|
|
|
+ "red")))
|
|
|
+ (setq noun (propertize noun 'face highlight-face))
|
|
|
+ (setq translation (propertize translation 'face highlight-face))
|
|
|
+ (list noun noun-root noun-gender noun-hint translation)))
|
|
|
+
|
|
|
+
|
|
|
+(defun org-drill-present-noun-declension ()
|
|
|
+ "Present a drill entry whose card type is 'decline_noun'."
|
|
|
+ (destructuring-bind (noun noun-root noun-gender noun-hint translation)
|
|
|
+ (org-drill-get-noun-info)
|
|
|
+ (let* ((props (org-entry-properties (point)))
|
|
|
+ (definite
|
|
|
+ (cond
|
|
|
+ ((assoc "DECLINE_DEFINITE" props)
|
|
|
+ (propertize (if (org-entry-get (point) "DECLINE_DEFINITE")
|
|
|
+ "definite" "indefinite")
|
|
|
+ 'face 'warning))
|
|
|
+ (t nil)))
|
|
|
+ (plural
|
|
|
+ (cond
|
|
|
+ ((assoc "DECLINE_PLURAL" props)
|
|
|
+ (propertize (if (org-entry-get (point) "DECLINE_PLURAL")
|
|
|
+ "plural" "singular")
|
|
|
+ 'face 'warning))
|
|
|
+ (t nil))))
|
|
|
+ (org-drill-present-card-using-text
|
|
|
+ (cond
|
|
|
+ ((zerop (random* 2))
|
|
|
+ (format "\nTranslate the noun\n\n%s (%s)\n\nand list its declensions%s.\n\n"
|
|
|
+ noun noun-gender
|
|
|
+ (if (or plural definite)
|
|
|
+ (format " for the %s %s form" definite plural)
|
|
|
+ "")))
|
|
|
+ (t
|
|
|
+ (format "\nGive the noun that means\n\n%s %s\n
|
|
|
+and list its declensions%s.\n\n"
|
|
|
+ translation
|
|
|
+ (if noun-hint (format " [HINT: %s]" noun-hint) "")
|
|
|
+ (if (or plural definite)
|
|
|
+ (format " for the %s %s form" definite plural)
|
|
|
+ ""))))))))
|
|
|
+
|
|
|
+
|
|
|
+(defun org-drill-show-answer-noun-declension (reschedule-fn)
|
|
|
+ "Show the answer for a drill item whose card type is 'decline_noun'.
|
|
|
+RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and
|
|
|
+returns its return value."
|
|
|
+ (destructuring-bind (noun noun-root noun-gender noun-hint translation)
|
|
|
+ (org-drill-get-noun-info)
|
|
|
+ (with-replaced-entry-heading
|
|
|
+ (format "Declensions of %s (%s) ==> %s\n\n"
|
|
|
+ noun noun-gender translation)
|
|
|
+ (org-cycle-hide-drawers 'all)
|
|
|
(funcall reschedule-fn))))
|
|
|
|
|
|
|
|
|
;;; `translate_number' card type ==============================================
|
|
|
;;; See spanish.org for usage
|
|
|
|
|
|
-(defvar *drilled-number* 0)
|
|
|
-(defvar *drilled-number-direction* 'to-english)
|
|
|
+
|
|
|
+(defun spelln-integer-in-language (n lang)
|
|
|
+ (let ((spelln-language lang))
|
|
|
+ (spelln-integer-in-words n)))
|
|
|
|
|
|
(defun org-drill-present-translate-number ()
|
|
|
(let ((num-min (read (org-entry-get (point) "DRILL_NUMBER_MIN")))
|
|
|
(num-max (read (org-entry-get (point) "DRILL_NUMBER_MAX")))
|
|
|
(language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
|
|
|
+ (drilled-number 0)
|
|
|
+ (drilled-number-direction 'to-english)
|
|
|
(highlight-face 'font-lock-warning-face))
|
|
|
(cond
|
|
|
((not (fboundp 'spelln-integer-in-words))
|
|
@@ -2908,46 +3057,49 @@ returns its return value."
|
|
|
(if (> num-min num-max)
|
|
|
(psetf num-min num-max
|
|
|
num-max num-min))
|
|
|
- (setq *drilled-number*
|
|
|
+ (setq drilled-number
|
|
|
(+ num-min (random* (abs (1+ (- num-max num-min))))))
|
|
|
- (setq *drilled-number-direction*
|
|
|
+ (setq drilled-number-direction
|
|
|
(if (zerop (random* 2)) 'from-english 'to-english))
|
|
|
- (org-drill-present-card-using-text
|
|
|
- (if (eql 'to-english *drilled-number-direction*)
|
|
|
- (format "\nTranslate into English:\n\n%s\n"
|
|
|
- (let ((spelln-language language))
|
|
|
- (propertize
|
|
|
- (spelln-integer-in-words *drilled-number*)
|
|
|
- 'face highlight-face)))
|
|
|
+ (cond
|
|
|
+ ((eql 'to-english drilled-number-direction)
|
|
|
+ (org-drill-present-card-using-text
|
|
|
+ (format "\nTranslate into English:\n\n%s\n"
|
|
|
+ (propertize
|
|
|
+ (spelln-integer-in-language drilled-number language)
|
|
|
+ 'face highlight-face))
|
|
|
+ (spelln-integer-in-language drilled-number 'english-gb)))
|
|
|
+ (t
|
|
|
+ (org-drill-present-card-using-text
|
|
|
(format "\nTranslate into %s:\n\n%s\n"
|
|
|
(capitalize (format "%s" language))
|
|
|
- (let ((spelln-language 'english-gb))
|
|
|
- (propertize
|
|
|
- (spelln-integer-in-words *drilled-number*)
|
|
|
- 'face highlight-face)))))))))
|
|
|
-
|
|
|
-
|
|
|
-(defun org-drill-show-answer-translate-number (reschedule-fn)
|
|
|
- (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
|
|
|
- (highlight-face 'font-lock-warning-face)
|
|
|
- (non-english
|
|
|
- (let ((spelln-language language))
|
|
|
- (propertize (spelln-integer-in-words *drilled-number*)
|
|
|
- 'face highlight-face)))
|
|
|
- (english
|
|
|
- (let ((spelln-language 'english-gb))
|
|
|
- (propertize (spelln-integer-in-words *drilled-number*)
|
|
|
- 'face 'highlight-face))))
|
|
|
- (with-replaced-entry-text
|
|
|
- (cond
|
|
|
- ((eql 'to-english *drilled-number-direction*)
|
|
|
- (format "\nThe English translation of %s is:\n\n%s\n"
|
|
|
- non-english english))
|
|
|
- (t
|
|
|
- (format "\nThe %s translation of %s is:\n\n%s\n"
|
|
|
- (capitalize (format "%s" language))
|
|
|
- english non-english)))
|
|
|
- (funcall reschedule-fn))))
|
|
|
+ (propertize
|
|
|
+ (spelln-integer-in-language drilled-number 'english-gb)
|
|
|
+ 'face highlight-face))
|
|
|
+ (spelln-integer-in-language drilled-number language))))))))
|
|
|
+
|
|
|
+
|
|
|
+;; (defun org-drill-show-answer-translate-number (reschedule-fn)
|
|
|
+;; (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
|
|
|
+;; (highlight-face 'font-lock-warning-face)
|
|
|
+;; (non-english
|
|
|
+;; (let ((spelln-language language))
|
|
|
+;; (propertize (spelln-integer-in-words *drilled-number*)
|
|
|
+;; 'face highlight-face)))
|
|
|
+;; (english
|
|
|
+;; (let ((spelln-language 'english-gb))
|
|
|
+;; (propertize (spelln-integer-in-words *drilled-number*)
|
|
|
+;; 'face 'highlight-face))))
|
|
|
+;; (with-replaced-entry-text
|
|
|
+;; (cond
|
|
|
+;; ((eql 'to-english *drilled-number-direction*)
|
|
|
+;; (format "\nThe English translation of %s is:\n\n%s\n"
|
|
|
+;; non-english english))
|
|
|
+;; (t
|
|
|
+;; (format "\nThe %s translation of %s is:\n\n%s\n"
|
|
|
+;; (capitalize (format "%s" language))
|
|
|
+;; english non-english)))
|
|
|
+;; (funcall reschedule-fn))))
|
|
|
|
|
|
|
|
|
;;; `spanish_verb' card type ==================================================
|