mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-11-25 07:27:57 +00:00
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
|
||||
;;;
|
||||
;;; 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)))))))))
|
||||
(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))))
|
||||
;; (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 ==================================================
|
||||
|
||||
Loading…
Reference in New Issue
Block a user