forked from mirrors/org-mode
contrib/lisp/: Update org-drill.el to version 2.3.7
Thanks to Paul Sexton for maintaining org-drill.el!
This commit is contained in:
Bastien Guerry
parent
30d6dc8baa
commit
0030e16002
|
|
@ -2,7 +2,7 @@
|
||||||
;;; org-drill.el - Self-testing using spaced repetition
|
;;; org-drill.el - Self-testing using spaced repetition
|
||||||
;;;
|
;;;
|
||||||
;;; Author: Paul Sexton <eeeickythump@gmail.com>
|
;;; Author: Paul Sexton <eeeickythump@gmail.com>
|
||||||
;;; Version: 2.3.6
|
;;; Version: 2.3.7
|
||||||
;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
|
;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
|
||||||
;;;
|
;;;
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -188,11 +188,16 @@ during a drill session."
|
||||||
window t))
|
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
|
(defvar org-drill-cloze-regexp
|
||||||
;; ver 1 "[^][]\\(\\[[^][][^]]*\\]\\)"
|
(concat "\\(\\[[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|"
|
||||||
;; ver 2 "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)"
|
(regexp-quote org-drill-hint-separator)
|
||||||
;; ver 3! "\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)"
|
".+?\\)\\(\\]\\)"))
|
||||||
"\\(\\[[[:cntrl:][:graph:][:space:]]*?\\)\\(\\||.+?\\)\\(\\]\\)")
|
|
||||||
|
|
||||||
|
|
||||||
(defvar org-drill-cloze-keywords
|
(defvar org-drill-cloze-keywords
|
||||||
|
|
@ -204,39 +209,51 @@ during a drill session."
|
||||||
|
|
||||||
|
|
||||||
(defcustom org-drill-card-type-alist
|
(defcustom org-drill-card-type-alist
|
||||||
'((nil . org-drill-present-simple-card)
|
'((nil org-drill-present-simple-card)
|
||||||
("simple" . org-drill-present-simple-card)
|
("simple" org-drill-present-simple-card)
|
||||||
("twosided" . org-drill-present-two-sided-card)
|
("twosided" org-drill-present-two-sided-card nil t)
|
||||||
("multisided" . org-drill-present-multi-sided-card)
|
("multisided" org-drill-present-multi-sided-card nil t)
|
||||||
("hide1cloze" . org-drill-present-multicloze-hide1)
|
("hide1cloze" org-drill-present-multicloze-hide1)
|
||||||
("hide2cloze" . org-drill-present-multicloze-hide2)
|
("hide2cloze" org-drill-present-multicloze-hide2)
|
||||||
("show1cloze" . org-drill-present-multicloze-show1)
|
("show1cloze" org-drill-present-multicloze-show1)
|
||||||
("show2cloze" . org-drill-present-multicloze-show2)
|
("show2cloze" org-drill-present-multicloze-show2)
|
||||||
("multicloze" . org-drill-present-multicloze-hide1)
|
("multicloze" org-drill-present-multicloze-hide1)
|
||||||
("hidefirst" . org-drill-present-multicloze-hide-first)
|
("hidefirst" org-drill-present-multicloze-hide-first)
|
||||||
("hidelast" . org-drill-present-multicloze-hide-last)
|
("hidelast" org-drill-present-multicloze-hide-last)
|
||||||
("hide1_firstmore" . org-drill-present-multicloze-hide1-firstmore)
|
("hide1_firstmore" org-drill-present-multicloze-hide1-firstmore)
|
||||||
("show1_lastmore" . org-drill-present-multicloze-show1-lastmore)
|
("show1_lastmore" org-drill-present-multicloze-show1-lastmore)
|
||||||
("show1_firstless" . org-drill-present-multicloze-show1-firstless)
|
("show1_firstless" org-drill-present-multicloze-show1-firstless)
|
||||||
("conjugate" org-drill-present-verb-conjugation
|
("conjugate"
|
||||||
|
org-drill-present-verb-conjugation
|
||||||
org-drill-show-answer-verb-conjugation)
|
org-drill-show-answer-verb-conjugation)
|
||||||
("spanish_verb" . org-drill-present-spanish-verb)
|
("decline_noun"
|
||||||
("translate_number" org-drill-present-translate-number
|
org-drill-present-noun-declension
|
||||||
org-drill-show-answer-translate-number))
|
org-drill-show-answer-noun-declension)
|
||||||
"Alist associating card types with presentation functions. Each entry in the
|
("spanish_verb" org-drill-present-spanish-verb)
|
||||||
alist takes one of two forms:
|
("translate_number" org-drill-present-translate-number))
|
||||||
1. (CARDTYPE . QUESTION-FN), where CARDTYPE is a string or nil (for default),
|
"Alist associating card types with presentation functions. Each
|
||||||
and QUESTION-FN is a function which takes no arguments and returns a boolean
|
entry in the alist takes the form:
|
||||||
value.
|
|
||||||
2. (CARDTYPE QUESTION-FN ANSWER-FN), where ANSWER-FN is a function that takes
|
;;; (CARDTYPE QUESTION-FN [ANSWER-FN DRILL-EMPTY-P])
|
||||||
one argument -- the argument is a function that itself takes no arguments.
|
|
||||||
ANSWER-FN is called with the point on the active item's
|
Where CARDTYPE is a string or nil (for default), and QUESTION-FN
|
||||||
heading, just prior to displaying the item's 'answer'. It can therefore be
|
is a function which takes no arguments and returns a boolean
|
||||||
used to modify the appearance of the answer. ANSWER-FN must call its argument
|
value.
|
||||||
before returning. (Its argument is a function that prompts the user and
|
|
||||||
performs rescheduling)."
|
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
|
: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
|
(defcustom org-drill-scope
|
||||||
|
|
@ -419,6 +436,17 @@ exponential effect on inter-repetition spacing."
|
||||||
:type 'float)
|
: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-session-qualities* nil)
|
||||||
(defvar *org-drill-start-time* 0)
|
(defvar *org-drill-start-time* 0)
|
||||||
(defvar *org-drill-new-entries* nil)
|
(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))
|
((and (>= ch ?0) (<= ch ?5))
|
||||||
(let ((quality (- ch ?0))
|
(let ((quality (- ch ?0))
|
||||||
(failures (org-drill-entry-failure-count)))
|
(failures (org-drill-entry-failure-count)))
|
||||||
(save-excursion
|
(unless *org-drill-cram-mode*
|
||||||
(org-drill-smart-reschedule quality
|
(save-excursion
|
||||||
(nth quality next-review-dates)))
|
(org-drill-smart-reschedule quality
|
||||||
(push quality *org-drill-session-qualities*)
|
(nth quality next-review-dates)))
|
||||||
(cond
|
(push quality *org-drill-session-qualities*)
|
||||||
((<= quality org-drill-failure-quality)
|
(cond
|
||||||
(when org-drill-leech-failure-threshold
|
((<= quality org-drill-failure-quality)
|
||||||
;;(setq failures (if failures (string-to-number failures) 0))
|
(when org-drill-leech-failure-threshold
|
||||||
;; (org-set-property "DRILL_FAILURE_COUNT"
|
;;(setq failures (if failures (string-to-number failures) 0))
|
||||||
;; (format "%d" (1+ failures)))
|
;; (org-set-property "DRILL_FAILURE_COUNT"
|
||||||
(if (> (1+ failures) org-drill-leech-failure-threshold)
|
;; (format "%d" (1+ failures)))
|
||||||
(org-toggle-tag "leech" 'on))))
|
(if (> (1+ failures) org-drill-leech-failure-threshold)
|
||||||
(t
|
(org-toggle-tag "leech" 'on))))
|
||||||
(let ((scheduled-time (org-get-scheduled-time (point))))
|
(t
|
||||||
(when scheduled-time
|
(let ((scheduled-time (org-get-scheduled-time (point))))
|
||||||
(message "Next review in %d days"
|
(when scheduled-time
|
||||||
(- (time-to-days scheduled-time)
|
(message "Next review in %d days"
|
||||||
(time-to-days (current-time))))
|
(- (time-to-days scheduled-time)
|
||||||
(sit-for 0.5)))))
|
(time-to-days (current-time))))
|
||||||
(org-set-property "DRILL_LAST_QUALITY" (format "%d" quality))
|
(sit-for 0.5)))))
|
||||||
(org-set-property "DRILL_LAST_REVIEWED"
|
(org-set-property "DRILL_LAST_QUALITY" (format "%d" quality))
|
||||||
(time-to-inactive-org-timestamp (current-time)))
|
(org-set-property "DRILL_LAST_REVIEWED"
|
||||||
|
(time-to-inactive-org-timestamp (current-time))))
|
||||||
quality))
|
quality))
|
||||||
((= ch ?e)
|
((= ch ?e)
|
||||||
'edit)
|
'edit)
|
||||||
|
|
@ -1361,9 +1390,13 @@ the current topic."
|
||||||
(format "%s %s %s %s %s %s"
|
(format "%s %s %s %s %s %s"
|
||||||
(propertize
|
(propertize
|
||||||
(char-to-string
|
(char-to-string
|
||||||
(case status
|
(cond
|
||||||
(:new ?N) (:young ?Y) (:old ?o) (:overdue ?!)
|
((eql status :failed) ?F)
|
||||||
(:failed ?F) (t ??)))
|
(*org-drill-cram-mode* ?C)
|
||||||
|
(t
|
||||||
|
(case status
|
||||||
|
(:new ?N) (:young ?Y) (:old ?o) (:overdue ?!)
|
||||||
|
(t ??)))))
|
||||||
'face `(:foreground
|
'face `(:foreground
|
||||||
,(case status
|
,(case status
|
||||||
(:new org-drill-new-count-color)
|
(: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)
|
(defun org-drill-hide-heading-at-point (&optional text)
|
||||||
(unless (org-at-heading-p)
|
(unless (org-at-heading-p)
|
||||||
(error "Point is not on a heading"))
|
(error "Point is not on a heading."))
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(let ((beg (point)))
|
(let ((beg (point)))
|
||||||
(end-of-line)
|
(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 ()
|
(defun org-drill-hide-matched-cloze-text ()
|
||||||
"Hide the current match with a 'cloze' visual overlay."
|
"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
|
(overlay-put ovl 'category
|
||||||
'org-drill-cloze-overlay-defaults)
|
'org-drill-cloze-overlay-defaults)
|
||||||
(when (find ?| (match-string 0))
|
(when (and hint-sep-pos
|
||||||
|
(> hint-sep-pos 1))
|
||||||
(let ((hint (substring-no-properties
|
(let ((hint (substring-no-properties
|
||||||
(match-string 0)
|
(match-string 0)
|
||||||
(1+ (position ?| (match-string 0)))
|
(+ hint-sep-pos (length org-drill-hint-separator))
|
||||||
(1- (length (match-string 0))))))
|
(1- (length (match-string 0))))))
|
||||||
(overlay-put
|
(overlay-put
|
||||||
ovl 'display
|
ovl 'display
|
||||||
;; If hint is like `X...' then display [X...]
|
;; If hint is like `X...' then display [X...]
|
||||||
;; otherwise display [...X]
|
;; otherwise display [...X]
|
||||||
(format (if (string-match-p "\\.\\.\\." hint) "[%s]" "[%s...]")
|
(format (if (string-match-p (regexp-quote "...") hint) "[%s]" "[%s...]")
|
||||||
hint))))))
|
hint))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1601,13 +1637,24 @@ Note: does not actually alter the item."
|
||||||
(substring-no-properties text))))
|
(substring-no-properties text))))
|
||||||
|
|
||||||
|
|
||||||
(defun org-drill-entry-empty-p ()
|
;; (defun org-entry-empty-p ()
|
||||||
(zerop (length (org-drill-get-entry-text))))
|
;; (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 ====================================================
|
;;; Presentation functions ====================================================
|
||||||
|
;;
|
||||||
;; Each of these is called with point on topic heading. Each needs to show the
|
;; 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
|
;; 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
|
;; 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)
|
(defun org-drill-present-default-answer (reschedule-fn)
|
||||||
(org-drill-hide-subheadings-if 'org-drill-entry-p)
|
(cond
|
||||||
(org-drill-unhide-clozed-text)
|
(drill-answer
|
||||||
(ignore-errors
|
(with-replaced-entry-text
|
||||||
(org-display-inline-images t))
|
(format "\nAnswer:\n\n %s\n" drill-answer)
|
||||||
(with-hidden-cloze-hints
|
(prog1
|
||||||
(funcall reschedule-fn)))
|
(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 ()
|
(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)
|
(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-hidden-comments
|
||||||
(with-replaced-entry-text
|
(with-replaced-entry-text
|
||||||
question
|
(concat "\n" question)
|
||||||
(org-drill-hide-all-subheadings-except nil)
|
(org-drill-hide-all-subheadings-except nil)
|
||||||
(org-cycle-hide-drawers 'all)
|
(org-cycle-hide-drawers 'all)
|
||||||
(ignore-errors
|
(ignore-errors
|
||||||
|
|
@ -1964,7 +2022,9 @@ pieces rather than one."
|
||||||
(defun org-drill-present-card-using-multiple-overlays (replacements &optional answer)
|
(defun org-drill-present-card-using-multiple-overlays (replacements &optional answer)
|
||||||
"TEXTS is a list of valid values for the 'display' text property.
|
"TEXTS is a list of valid values for the 'display' text property.
|
||||||
Present these overlays, in sequence, as the only
|
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-hidden-comments
|
||||||
(with-replaced-entry-text-multi
|
(with-replaced-entry-text-multi
|
||||||
replacements
|
replacements
|
||||||
|
|
@ -1995,20 +2055,24 @@ See `org-drill' for more details."
|
||||||
;; (org-back-to-heading))
|
;; (org-back-to-heading))
|
||||||
(let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
|
(let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
|
||||||
(answer-fn 'org-drill-present-default-answer)
|
(answer-fn 'org-drill-present-default-answer)
|
||||||
|
(present-empty-cards nil)
|
||||||
(cont nil)
|
(cont nil)
|
||||||
;; fontification functions in `outline-view-change-hook' can cause big
|
;; fontification functions in `outline-view-change-hook' can cause big
|
||||||
;; slowdowns, so we temporarily bind this variable to nil here.
|
;; slowdowns, so we temporarily bind this variable to nil here.
|
||||||
(outline-view-change-hook nil))
|
(outline-view-change-hook nil))
|
||||||
|
(setq drill-answer nil)
|
||||||
(org-save-outline-visibility t
|
(org-save-outline-visibility t
|
||||||
(save-restriction
|
(save-restriction
|
||||||
(org-narrow-to-subtree)
|
(org-narrow-to-subtree)
|
||||||
(org-show-subtree)
|
(org-show-subtree)
|
||||||
(org-cycle-hide-drawers 'all)
|
(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)
|
(if (listp presentation-fn)
|
||||||
(psetq answer-fn (or (second presentation-fn)
|
(psetq answer-fn (or (second presentation-fn)
|
||||||
'org-drill-present-default-answer)
|
'org-drill-present-default-answer)
|
||||||
|
present-empty-cards (third presentation-fn)
|
||||||
presentation-fn (first presentation-fn)))
|
presentation-fn (first presentation-fn)))
|
||||||
(cond
|
(cond
|
||||||
((null presentation-fn)
|
((null presentation-fn)
|
||||||
|
|
@ -2034,6 +2098,7 @@ See `org-drill' for more details."
|
||||||
|
|
||||||
(defun org-drill-entries-pending-p ()
|
(defun org-drill-entries-pending-p ()
|
||||||
(or *org-drill-again-entries*
|
(or *org-drill-again-entries*
|
||||||
|
*org-drill-current-item*
|
||||||
(and (not (org-drill-maximum-item-count-reached-p))
|
(and (not (org-drill-maximum-item-count-reached-p))
|
||||||
(not (org-drill-maximum-duration-reached-p))
|
(not (org-drill-maximum-duration-reached-p))
|
||||||
(or *org-drill-new-entries*
|
(or *org-drill-new-entries*
|
||||||
|
|
@ -2045,7 +2110,8 @@ See `org-drill' for more details."
|
||||||
|
|
||||||
|
|
||||||
(defun org-drill-pending-entry-count ()
|
(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-failed-entries*)
|
||||||
(length *org-drill-young-mature-entries*)
|
(length *org-drill-young-mature-entries*)
|
||||||
(length *org-drill-old-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
|
"Returns true if the current drill session has continued past its
|
||||||
maximum duration."
|
maximum duration."
|
||||||
(and org-drill-maximum-duration
|
(and org-drill-maximum-duration
|
||||||
|
(not *org-drill-cram-mode*)
|
||||||
*org-drill-start-time*
|
*org-drill-start-time*
|
||||||
(> (- (float-time (current-time)) *org-drill-start-time*)
|
(> (- (float-time (current-time)) *org-drill-start-time*)
|
||||||
(* org-drill-maximum-duration 60))))
|
(* org-drill-maximum-duration 60))))
|
||||||
|
|
@ -2066,6 +2133,7 @@ maximum duration."
|
||||||
"Returns true if the current drill session has reached the
|
"Returns true if the current drill session has reached the
|
||||||
maximum number of items."
|
maximum number of items."
|
||||||
(and org-drill-maximum-items-per-session
|
(and org-drill-maximum-items-per-session
|
||||||
|
(not *org-drill-cram-mode*)
|
||||||
(>= (length *org-drill-done-entries*)
|
(>= (length *org-drill-done-entries*)
|
||||||
org-drill-maximum-items-per-session)))
|
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))
|
(setq end-pos (point-marker))
|
||||||
(return-from org-drill-entries nil))
|
(return-from org-drill-entries nil))
|
||||||
((eql result 'skip)
|
((eql result 'skip)
|
||||||
|
(setq *org-drill-current-item* nil)
|
||||||
nil) ; skip this item
|
nil) ; skip this item
|
||||||
(t
|
(t
|
||||||
(cond
|
(cond
|
||||||
|
|
@ -2166,7 +2235,8 @@ RESUMING-P is true if we are resuming a suspended drill session."
|
||||||
(shuffle-list *org-drill-again-entries*)))
|
(shuffle-list *org-drill-again-entries*)))
|
||||||
(push-end m *org-drill-again-entries*))
|
(push-end m *org-drill-again-entries*))
|
||||||
(t
|
(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))
|
(> qual org-drill-failure-quality))
|
||||||
*org-drill-session-qualities*))
|
*org-drill-session-qualities*))
|
||||||
(max 1 (length *org-drill-session-qualities*))))
|
(max 1 (length *org-drill-session-qualities*))))
|
||||||
(prompt nil))
|
(prompt nil)
|
||||||
|
(max-mini-window-height 0.6))
|
||||||
(setq prompt
|
(setq prompt
|
||||||
(format
|
(format
|
||||||
"%d items reviewed. Session duration %s.
|
"%d items reviewed. Session duration %s.
|
||||||
|
|
@ -2305,8 +2376,14 @@ one of the following values:
|
||||||
(cond
|
(cond
|
||||||
((not (org-drill-entry-p))
|
((not (org-drill-entry-p))
|
||||||
nil)
|
nil)
|
||||||
((org-drill-entry-empty-p)
|
((and (org-entry-empty-p)
|
||||||
nil) ; skip -- item body is empty
|
(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
|
((null due) ; unscheduled - usually a skipped leech
|
||||||
:unscheduled)
|
:unscheduled)
|
||||||
;; ((eql -1 due)
|
;; ((eql -1 due)
|
||||||
|
|
@ -2446,47 +2523,16 @@ than starting a new one."
|
||||||
(:overdue
|
(:overdue
|
||||||
(push (cons (point-marker) due) overdue-data))
|
(push (cons (point-marker) due) overdue-data))
|
||||||
(:old
|
(:old
|
||||||
(push (point-marker) *org-drill-old-mature-entries*)))))))
|
(push (point-marker) *org-drill-old-mature-entries*))
|
||||||
|
)))))
|
||||||
scope)
|
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)
|
(org-drill-order-overdue-entries overdue-data)
|
||||||
(setq *org-drill-overdue-entry-count*
|
(setq *org-drill-overdue-entry-count*
|
||||||
(length *org-drill-overdue-entries*))))
|
(length *org-drill-overdue-entries*))))
|
||||||
(setq *org-drill-due-entry-count* (org-drill-pending-entry-count))
|
(setq *org-drill-due-entry-count* (org-drill-pending-entry-count))
|
||||||
(cond
|
(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-failed-entries*)
|
||||||
(null *org-drill-overdue-entries*)
|
(null *org-drill-overdue-entries*)
|
||||||
(null *org-drill-young-mature-entries*)
|
(null *org-drill-young-mature-entries*)
|
||||||
|
|
@ -2497,6 +2543,7 @@ than starting a new one."
|
||||||
(message "Drill session finished!"))))
|
(message "Drill session finished!"))))
|
||||||
(progn
|
(progn
|
||||||
(unless end-pos
|
(unless end-pos
|
||||||
|
(setq *org-drill-cram-mode* nil)
|
||||||
(org-drill-free-markers *org-drill-done-entries*)))))
|
(org-drill-free-markers *org-drill-done-entries*)))))
|
||||||
(cond
|
(cond
|
||||||
(end-pos
|
(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'
|
have been reviewed within the last `org-drill-cram-hours'
|
||||||
hours."
|
hours."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((*org-drill-cram-mode* t))
|
(setq *org-drill-cram-mode* t)
|
||||||
(org-drill scope)))
|
(org-drill scope))
|
||||||
|
|
||||||
|
|
||||||
(defun org-drill-tree ()
|
(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
|
unreviewed items. If there are no leftover items in memory, a full
|
||||||
scan will be performed."
|
scan will be performed."
|
||||||
(interactive)
|
(interactive)
|
||||||
|
(setq *org-drill-cram-mode* nil)
|
||||||
(cond
|
(cond
|
||||||
((plusp (org-drill-pending-entry-count))
|
((plusp (org-drill-pending-entry-count))
|
||||||
(org-drill-free-markers *org-drill-done-entries*)
|
(org-drill-free-markers *org-drill-done-entries*)
|
||||||
|
|
@ -2883,19 +2931,120 @@ returns its return value."
|
||||||
(mood
|
(mood
|
||||||
(format "%s mood" mood))))
|
(format "%s mood" mood))))
|
||||||
infinitive translation)
|
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))))
|
(funcall reschedule-fn))))
|
||||||
|
|
||||||
|
|
||||||
;;; `translate_number' card type ==============================================
|
;;; `translate_number' card type ==============================================
|
||||||
;;; See spanish.org for usage
|
;;; 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 ()
|
(defun org-drill-present-translate-number ()
|
||||||
(let ((num-min (read (org-entry-get (point) "DRILL_NUMBER_MIN")))
|
(let ((num-min (read (org-entry-get (point) "DRILL_NUMBER_MIN")))
|
||||||
(num-max (read (org-entry-get (point) "DRILL_NUMBER_MAX")))
|
(num-max (read (org-entry-get (point) "DRILL_NUMBER_MAX")))
|
||||||
(language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
|
(language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
|
||||||
|
(drilled-number 0)
|
||||||
|
(drilled-number-direction 'to-english)
|
||||||
(highlight-face 'font-lock-warning-face))
|
(highlight-face 'font-lock-warning-face))
|
||||||
(cond
|
(cond
|
||||||
((not (fboundp 'spelln-integer-in-words))
|
((not (fboundp 'spelln-integer-in-words))
|
||||||
|
|
@ -2908,46 +3057,49 @@ returns its return value."
|
||||||
(if (> num-min num-max)
|
(if (> num-min num-max)
|
||||||
(psetf num-min num-max
|
(psetf num-min num-max
|
||||||
num-max num-min))
|
num-max num-min))
|
||||||
(setq *drilled-number*
|
(setq drilled-number
|
||||||
(+ num-min (random* (abs (1+ (- num-max num-min))))))
|
(+ 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))
|
(if (zerop (random* 2)) 'from-english 'to-english))
|
||||||
(org-drill-present-card-using-text
|
(cond
|
||||||
(if (eql 'to-english *drilled-number-direction*)
|
((eql 'to-english drilled-number-direction)
|
||||||
(format "\nTranslate into English:\n\n%s\n"
|
(org-drill-present-card-using-text
|
||||||
(let ((spelln-language language))
|
(format "\nTranslate into English:\n\n%s\n"
|
||||||
(propertize
|
(propertize
|
||||||
(spelln-integer-in-words *drilled-number*)
|
(spelln-integer-in-language drilled-number language)
|
||||||
'face highlight-face)))
|
'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"
|
(format "\nTranslate into %s:\n\n%s\n"
|
||||||
(capitalize (format "%s" language))
|
(capitalize (format "%s" language))
|
||||||
(let ((spelln-language 'english-gb))
|
(propertize
|
||||||
(propertize
|
(spelln-integer-in-language drilled-number 'english-gb)
|
||||||
(spelln-integer-in-words *drilled-number*)
|
'face highlight-face))
|
||||||
'face highlight-face)))))))))
|
(spelln-integer-in-language drilled-number language))))))))
|
||||||
|
|
||||||
|
|
||||||
(defun org-drill-show-answer-translate-number (reschedule-fn)
|
;; (defun org-drill-show-answer-translate-number (reschedule-fn)
|
||||||
(let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
|
;; (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
|
||||||
(highlight-face 'font-lock-warning-face)
|
;; (highlight-face 'font-lock-warning-face)
|
||||||
(non-english
|
;; (non-english
|
||||||
(let ((spelln-language language))
|
;; (let ((spelln-language language))
|
||||||
(propertize (spelln-integer-in-words *drilled-number*)
|
;; (propertize (spelln-integer-in-words *drilled-number*)
|
||||||
'face highlight-face)))
|
;; 'face highlight-face)))
|
||||||
(english
|
;; (english
|
||||||
(let ((spelln-language 'english-gb))
|
;; (let ((spelln-language 'english-gb))
|
||||||
(propertize (spelln-integer-in-words *drilled-number*)
|
;; (propertize (spelln-integer-in-words *drilled-number*)
|
||||||
'face 'highlight-face))))
|
;; 'face 'highlight-face))))
|
||||||
(with-replaced-entry-text
|
;; (with-replaced-entry-text
|
||||||
(cond
|
;; (cond
|
||||||
((eql 'to-english *drilled-number-direction*)
|
;; ((eql 'to-english *drilled-number-direction*)
|
||||||
(format "\nThe English translation of %s is:\n\n%s\n"
|
;; (format "\nThe English translation of %s is:\n\n%s\n"
|
||||||
non-english english))
|
;; non-english english))
|
||||||
(t
|
;; (t
|
||||||
(format "\nThe %s translation of %s is:\n\n%s\n"
|
;; (format "\nThe %s translation of %s is:\n\n%s\n"
|
||||||
(capitalize (format "%s" language))
|
;; (capitalize (format "%s" language))
|
||||||
english non-english)))
|
;; english non-english)))
|
||||||
(funcall reschedule-fn))))
|
;; (funcall reschedule-fn))))
|
||||||
|
|
||||||
|
|
||||||
;;; `spanish_verb' card type ==================================================
|
;;; `spanish_verb' card type ==================================================
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue