Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode

This commit is contained in:
Eric Schulte 2010-09-19 10:53:21 -06:00
commit 7800234e04
6 changed files with 608 additions and 242 deletions

View file

@ -31,9 +31,9 @@ Currently I do not recommend to turn it on globally using
the variable =org-startup-indented=. But you can turn it on
for a particular buffer using
#+begin_src org
#+begin_example
,#+STARTUP: indent
#+end_src
#+end_example
Turning on this minor mode automatically turns on
=org-hide-leading-stars=, and it turns off
@ -7369,8 +7369,9 @@ list of small improvements and some new significant features.
- Export content specified via the #+TEXT construct is now
fully processed, i.e. links, emphasis etc. are all
interpreted. #+TEXT lines may include
#+BEGIN_HTML...#+END_HTML sections to embed literal HTML.
interpreted. #+TEXT lines may
include #+BEGIN_HTML... #+END_HTML sections to embed literal
HTML.
- During HTML export, you can request to have a_{b}
interpreted as a subscript, but to leave a_b as it is. This

View file

@ -1,7 +1,7 @@
;;; org-drill.el - Self-testing with org-learn
;;;
;;; Author: Paul Sexton <eeeickythump@gmail.com>
;;; Version: 1.0
;;; Version: 1.4
;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
;;;
;;;
@ -96,6 +96,12 @@ Possible values:
(defface org-drill-visible-cloze-face
'((t (:foreground "darkseagreen")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
(defface org-drill-visible-cloze-hint-face
'((t (:foreground "dark slate blue")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
@ -115,6 +121,35 @@ buffers?"
:group 'org-drill)
(defcustom org-drill-new-count-color
"royal blue"
"Foreground colour used to display the count of remaining new items
during a drill session."
:group 'org-drill
:type 'color)
(defcustom org-drill-mature-count-color
"green"
"Foreground colour used to display the count of remaining mature items
during a drill session. Mature items are due for review, but are not new."
:group 'org-drill
:type 'color)
(defcustom org-drill-failed-count-color
"red"
"Foreground colour used to display the count of remaining failed items
during a drill session."
:group 'org-drill
:type 'color)
(defcustom org-drill-done-count-color
"sienna"
"Foreground colour used to display the count of reviewed items
during a drill session."
:group 'org-drill
:type 'color)
(setplist 'org-drill-cloze-overlay-defaults
'(display "[...]"
face org-drill-hidden-cloze-face
@ -124,7 +159,15 @@ buffers?"
(defvar org-drill-cloze-regexp
;; ver 1 "[^][]\\(\\[[^][][^]]*\\]\\)"
;; ver 2 "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)"
"\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)")
;; ver 3! "\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)"
"\\(\\[[[:cntrl:][:graph:][:space:]]*?\\)\\(\\||.+?\\)\\(\\]\\)")
(defvar org-drill-cloze-keywords
`((,org-drill-cloze-regexp
(1 'org-drill-visible-cloze-face nil)
(2 'org-drill-visible-cloze-hint-face t)
(3 'org-drill-visible-cloze-face nil)
)))
(defcustom org-drill-card-type-alist
@ -132,6 +175,7 @@ buffers?"
("simple" . org-drill-present-simple-card)
("twosided" . org-drill-present-two-sided-card)
("multisided" . org-drill-present-multi-sided-card)
("multicloze" . org-drill-present-multicloze)
("spanish_verb" . org-drill-present-spanish-verb))
"Alist associating card types with presentation functions. Each entry in the
alist takes the form (CARDTYPE . FUNCTION), where CARDTYPE is a string
@ -158,11 +202,41 @@ random noise is adapted from Mnemosyne."
:group 'org-drill
:type 'boolean)
(defcustom org-drill-cram-hours
12
"When in cram mode, items are considered due for review if
they were reviewed at least this many hours ago."
:group 'org-drill
:type 'integer)
(defvar *org-drill-done-entry-count* 0)
(defvar *org-drill-pending-entry-count* 0)
(defvar *org-drill-session-qualities* nil)
(defvar *org-drill-start-time* 0)
(defvar *org-drill-new-entries* nil)
(defvar *org-drill-mature-entries* nil)
(defvar *org-drill-failed-entries* nil)
(defvar *org-drill-again-entries* nil)
(defvar *org-drill-done-entries* nil)
(defvar *org-drill-cram-mode* nil
"Are we in 'cram mode', where all items are considered due
for review unless they were already reviewed in the recent past?")
;;;; Utilities ================================================================
(defun free-marker (m)
(set-marker m nil))
(defmacro pop-random (place)
(let ((elt (gensym)))
`(if (null ,place)
nil
(let ((,elt (nth (random (length ,place)) ,place)))
(setq ,place (remove ,elt ,place))
,elt))))
(defun shuffle-list (list)
@ -181,10 +255,52 @@ random noise is adapted from Mnemosyne."
list)
(defun time-to-inactive-org-timestamp (time)
(format-time-string
(concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
time))
(defmacro with-hidden-cloze-text (&rest body)
`(progn
(org-drill-hide-clozed-text)
(unwind-protect
(progn
,@body)
(org-drill-unhide-clozed-text))))
(defun org-drill-days-since-last-review ()
"Nil means a last review date has not yet been stored for
the item.
Zero means it was reviewed today.
A positive number means it was reviewed that many days ago.
A negative number means the date of last review is in the future --
this should never happen."
(let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
(when datestr
(- (time-to-days (current-time))
(time-to-days (apply 'encode-time
(org-parse-time-string datestr)))))))
(defun org-drill-hours-since-last-review ()
"Like `org-drill-days-since-last-review', but return value is
in hours rather than days."
(let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
(when datestr
(floor
(/ (- (time-to-seconds (current-time))
(time-to-seconds (apply 'encode-time
(org-parse-time-string datestr))))
(* 60 60))))))
(defun org-drill-entry-p ()
"Is the current entry a 'drill item'?"
(or (assoc "LEARN_DATA" (org-entry-properties nil))
(or (org-entry-get (point) "LEARN_DATA")
;;(assoc "LEARN_DATA" (org-entry-properties nil))
(member org-drill-question-tag (org-get-local-tags))))
@ -196,6 +312,19 @@ or a subheading within a drill item?"
(member org-drill-question-tag (org-get-tags-at))))
(defun org-drill-goto-drill-entry-heading ()
"Move the point to the heading which hold the :drill: tag for this
drill entry."
(unless (org-at-heading-p)
(org-back-to-heading))
(unless (org-part-of-drill-entry-p)
(error "Point is not inside a drill entry"))
(while (not (org-drill-entry-p))
(unless (org-up-heading-safe)
(error "Cannot find a parent heading that is marked as a drill entry"))))
(defun org-drill-entry-leech-p ()
"Is the current entry a 'leech item'?"
(and (org-drill-entry-p)
@ -203,25 +332,32 @@ or a subheading within a drill item?"
(defun org-drill-entry-due-p ()
(let ((item-time (org-get-scheduled-time (point))))
(and (org-drill-entry-p)
(or (not (eql 'skip org-drill-leech-method))
(not (org-drill-entry-leech-p)))
(or (null item-time)
(not (minusp ; scheduled for today/in future
(- (time-to-days (current-time))
(time-to-days item-time))))))))
(cond
(*org-drill-cram-mode*
(let ((hours (org-drill-hours-since-last-review)))
(and (org-drill-entry-p)
(or (null hours)
(>= hours org-drill-cram-hours)))))
(t
(let ((item-time (org-get-scheduled-time (point))))
(and (org-drill-entry-p)
(or (not (eql 'skip org-drill-leech-method))
(not (org-drill-entry-leech-p)))
(or (null item-time)
(not (minusp ; scheduled for today/in future
(- (time-to-days (current-time))
(time-to-days item-time))))))))))
(defun org-drill-entry-new-p ()
(let ((item-time (org-get-scheduled-time (point))))
(and (org-drill-entry-p)
(and (org-drill-entry-p)
(let ((item-time (org-get-scheduled-time (point))))
(null item-time))))
(defun org-drill-entry-last-quality ()
(let ((quality (cdr (assoc "DRILL_LAST_QUALITY" (org-entry-properties nil)))))
(let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY")))
(if quality
(string-to-number quality)
nil)))
@ -351,6 +487,8 @@ Returns a list: (INTERVAL N EF OFMATRIX), where:
(cond
((= 0 (nth 0 learn-data))
(org-schedule t))
((minusp (first learn-data))
(org-schedule nil (current-time)))
(t
(org-schedule nil (time-add (current-time)
(days-to-time (nth 0 learn-data))))))))
@ -359,8 +497,8 @@ Returns a list: (INTERVAL N EF OFMATRIX), where:
(defun org-drill-reschedule ()
"Returns quality rating (0-5), or nil if the user quit."
(let ((ch nil))
(while (not (memq ch '(?q ?0 ?1 ?2 ?3 ?4 ?5)))
(setq ch (read-char
(while (not (memq ch '(?q ?e ?0 ?1 ?2 ?3 ?4 ?5)))
(setq ch (read-char-exclusive
(if (eq ch ??)
"0-2 Means you have forgotten the item.
3-5 Means you have remembered the item.
@ -372,12 +510,14 @@ Returns a list: (INTERVAL N EF OFMATRIX), where:
4 - After a little bit of thought you remembered.
5 - You remembered the item really easily.
How well did you do? (0-5, ?=help, q=quit)"
"How well did you do? (0-5, ?=help, q=quit)"))))
How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
"How well did you do? (0-5, ?=help, e=edit, q=quit)")))
(if (eql ch ?t)
(org-set-tags-command)))
(cond
((and (>= ch ?0) (<= ch ?5))
(let ((quality (- ch ?0))
(failures (cdr (assoc "DRILL_FAILURE_COUNT" (org-entry-properties nil)))))
(failures (org-entry-get (point) "DRILL_FAILURE_COUNT")))
(save-excursion
(org-drill-smart-reschedule quality))
(push quality *org-drill-session-qualities*)
@ -388,9 +528,20 @@ How well did you do? (0-5, ?=help, q=quit)"
(org-set-property "DRILL_FAILURE_COUNT"
(format "%d" (1+ failures)))
(if (> (1+ failures) org-drill-leech-failure-threshold)
(org-toggle-tag "leech" 'on)))))
(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)
(t
nil))))
@ -416,42 +567,92 @@ the current topic."
(defun org-drill-presentation-prompt (&rest fmt-and-args)
(let ((ch nil)
(prompt
(if fmt-and-args
(apply 'format
(first fmt-and-args)
(rest fmt-and-args))
"Press any key to see the answer, 'e' to edit, 'q' to quit.")))
(let* ((item-start-time (current-time))
(ch nil)
(last-second 0)
(prompt
(if fmt-and-args
(apply 'format
(first fmt-and-args)
(rest fmt-and-args))
(concat "Press key for answer, "
"e=edit, t=tags, s=skip, q=quit."))))
(setq prompt
(format "(%d) %s" *org-drill-pending-entry-count* prompt))
(format "%s %s %s %s %s"
(propertize
(number-to-string (length *org-drill-done-entries*))
'face `(:foreground ,org-drill-done-count-color)
'help-echo "The number of items you have reviewed this session.")
(propertize
(number-to-string (+ (length *org-drill-again-entries*)
(length *org-drill-failed-entries*)))
'face `(:foreground ,org-drill-failed-count-color)
'help-echo (concat "The number of items that you failed, "
"and need to review again."))
(propertize
(number-to-string (length *org-drill-mature-entries*))
'face `(:foreground ,org-drill-mature-count-color)
'help-echo "The number of old items due for review.")
(propertize
(number-to-string (length *org-drill-new-entries*))
'face `(:foreground ,org-drill-new-count-color)
'help-echo (concat "The number of new items that you "
"have never reviewed."))
prompt))
(if (and (eql 'warn org-drill-leech-method)
(org-drill-entry-leech-p))
(setq prompt (concat "!!! LEECH ITEM !!!
(setq prompt (concat
(propertize "!!! LEECH ITEM !!!
You seem to be having a lot of trouble memorising this item.
Consider reformulating the item to make it easier to remember.\n" prompt)))
(setq ch (read-char prompt))
Consider reformulating the item to make it easier to remember.\n"
'face '(:foreground "red"))
prompt)))
(while (memq ch '(nil ?t))
(while (not (input-pending-p))
(message (concat (format-time-string
"%M:%S " (time-subtract
(current-time) item-start-time))
prompt))
(sit-for 1))
(setq ch (read-char-exclusive))
(if (eql ch ?t)
(org-set-tags-command)))
(case ch
(?q nil)
(?e 'edit)
(?s 'skip)
(otherwise t))))
(defun org-pos-in-regexp (pos regexp &optional nlines)
(save-excursion
(goto-char pos)
(org-in-regexp regexp nlines)))
(defun org-drill-hide-clozed-text ()
(let ((ovl nil))
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
(setf ovl (make-overlay (match-beginning 0) (match-end 0)))
(overlay-put ovl 'category
'org-drill-cloze-overlay-defaults)
(when (find ?| (match-string 0))
(overlay-put ovl
'display
(format "[...%s]"
(substring-no-properties
(match-string 0)
(1+ (position ?| (match-string 0)))
(1- (length (match-string 0)))))))))))
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
;; Don't hide org links, partly because they might contain inline
;; images which we want to keep visible
(unless (org-pos-in-regexp (match-beginning 0)
org-bracket-link-regexp 1)
(org-drill-hide-matched-cloze-text)))))
(defun org-drill-hide-matched-cloze-text ()
"Hide the current match with a 'cloze' visual overlay."
(let ((ovl (make-overlay (match-beginning 0) (match-end 0))))
(overlay-put ovl 'category
'org-drill-cloze-overlay-defaults)
(when (find ?| (match-string 0))
(overlay-put ovl
'display
(format "[...%s]"
(substring-no-properties
(match-string 0)
(1+ (position ?| (match-string 0)))
(1- (length (match-string 0)))))))))
(defun org-drill-unhide-clozed-text ()
@ -472,80 +673,110 @@ Consider reformulating the item to make it easier to remember.\n" prompt)))
;; recall, nil if they chose to quit.
(defun org-drill-present-simple-card ()
(org-drill-hide-all-subheadings-except nil)
(prog1 (org-drill-presentation-prompt)
(org-show-subtree)))
(with-hidden-cloze-text
(org-drill-hide-all-subheadings-except nil)
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-show-subtree))))
(defun org-drill-present-two-sided-card ()
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(save-excursion
(goto-char (nth (random (min 2 (length drill-sections))) drill-sections))
(org-show-subtree)))
(prog1
(org-drill-presentation-prompt)
(org-show-subtree))))
(with-hidden-cloze-text
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(save-excursion
(goto-char (nth (random (min 2 (length drill-sections)))
drill-sections))
(org-show-subtree)))
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1
(org-drill-presentation-prompt)
(org-show-subtree)))))
(defun org-drill-present-multi-sided-card ()
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(with-hidden-cloze-text
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(save-excursion
(goto-char (nth (random (length drill-sections)) drill-sections))
(org-show-subtree)))
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1
(org-drill-presentation-prompt)
(org-show-subtree)))))
(defun org-drill-present-multicloze ()
(let ((item-end nil)
(match-count 0)
(body-start (or (cdr (org-get-property-block))
(point))))
(org-drill-hide-all-subheadings-except nil)
(save-excursion
(outline-next-heading)
(setq item-end (point)))
(save-excursion
(goto-char body-start)
(while (re-search-forward org-drill-cloze-regexp item-end t)
(incf match-count)))
(when (plusp match-count)
(save-excursion
(goto-char (nth (random (length drill-sections)) drill-sections))
(org-show-subtree)))
(prog1
(org-drill-presentation-prompt)
(org-show-subtree))))
(goto-char body-start)
(re-search-forward org-drill-cloze-regexp
item-end t (1+ (random match-count)))
(org-drill-hide-matched-cloze-text)))
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-show-subtree)
(org-drill-unhide-clozed-text))))
(defun org-drill-present-spanish-verb ()
(case (random 6)
(0
(org-drill-hide-all-subheadings-except '("Infinitive"))
(let ((prompt nil)
(reveal-headings nil))
(with-hidden-cloze-text
(case (random 6)
(0
(org-drill-hide-all-subheadings-except '("Infinitive"))
(setq prompt
(concat "Translate this Spanish verb, and conjugate it "
"for the *present* tense.")
reveal-headings '("English" "Present Tense" "Notes")))
(1
(org-drill-hide-all-subheadings-except '("English"))
(setq prompt (concat "For the *present* tense, conjugate the "
"Spanish translation of this English verb.")
reveal-headings '("Infinitive" "Present Tense" "Notes")))
(2
(org-drill-hide-all-subheadings-except '("Infinitive"))
(setq prompt (concat "Translate this Spanish verb, and "
"conjugate it for the *past* tense.")
reveal-headings '("English" "Past Tense" "Notes")))
(3
(org-drill-hide-all-subheadings-except '("English"))
(setq prompt (concat "For the *past* tense, conjugate the "
"Spanish translation of this English verb.")
reveal-headings '("Infinitive" "Past Tense" "Notes")))
(4
(org-drill-hide-all-subheadings-except '("Infinitive"))
(setq prompt (concat "Translate this Spanish verb, and "
"conjugate it for the *future perfect* tense.")
reveal-headings '("English" "Future Perfect Tense" "Notes")))
(5
(org-drill-hide-all-subheadings-except '("English"))
(setq prompt (concat "For the *future perfect* tense, conjugate the "
"Spanish translation of this English verb.")
reveal-headings '("Infinitive" "Future Perfect Tense" "Notes"))))
(org-cycle-hide-drawers 'all)
(prog1
(org-drill-presentation-prompt
"Translate this Spanish verb, and conjugate it for the *present* tense.")
(org-drill-hide-all-subheadings-except '("English" "Present Tense"
"Notes"))))
(1
(org-drill-hide-all-subheadings-except '("English"))
(prog1
(org-drill-presentation-prompt
"For the *present* tense, conjugate the Spanish translation of this English verb.")
(org-drill-hide-all-subheadings-except '("Infinitive" "Present Tense"
"Notes"))))
(2
(org-drill-hide-all-subheadings-except '("Infinitive"))
(prog1
(org-drill-presentation-prompt
"Translate this Spanish verb, and conjugate it for the *past* tense.")
(org-drill-hide-all-subheadings-except '("English" "Past Tense"
"Notes"))))
(3
(org-drill-hide-all-subheadings-except '("English"))
(prog1
(org-drill-presentation-prompt
"For the *past* tense, conjugate the Spanish translation of this English verb.")
(org-drill-hide-all-subheadings-except '("Infinitive" "Past Tense"
"Notes"))))
(4
(org-drill-hide-all-subheadings-except '("Infinitive"))
(prog1
(org-drill-presentation-prompt
"Translate this Spanish verb, and conjugate it for the *future perfect* tense.")
(org-drill-hide-all-subheadings-except '("English" "Future Perfect Tense"
"Notes"))))
(5
(org-drill-hide-all-subheadings-except '("English"))
(prog1
(org-drill-presentation-prompt
"For the *future perfect* tense, conjugate the Spanish translation of this English verb.")
(org-drill-hide-all-subheadings-except '("Infinitive" "Future Perfect Tense"
"Notes"))))))
(org-drill-presentation-prompt prompt)
(org-drill-hide-all-subheadings-except reveal-headings)))))
@ -559,9 +790,12 @@ EDIT if the user chose to exit the drill and edit the current item.
See `org-drill' for more details."
(interactive)
(unless (org-at-heading-p)
(org-back-to-heading))
(let ((card-type (cdr (assoc "DRILL_CARD_TYPE" (org-entry-properties nil))))
(org-drill-goto-drill-entry-heading)
;;(unless (org-part-of-drill-entry-p)
;; (error "Point is not inside a drill entry"))
;;(unless (org-at-heading-p)
;; (org-back-to-heading))
(let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
(cont nil))
(save-restriction
(org-narrow-to-subtree)
@ -571,15 +805,7 @@ See `org-drill' for more details."
(let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
(cond
(presentation-fn
(org-drill-hide-clozed-text)
;;(highlight-regexp org-drill-cloze-regexp
;; 'org-drill-hidden-cloze-face)
(unwind-protect
(progn
(setq cont (funcall presentation-fn)))
(org-drill-unhide-clozed-text))
;;(unhighlight-regexp org-drill-cloze-regexp)
)
(setq cont (funcall presentation-fn)))
(t
(error "Unknown card type: '%s'" card-type))))
@ -589,83 +815,188 @@ See `org-drill' for more details."
nil)
((eql cont 'edit)
'edit)
((eql cont 'skip)
'skip)
(t
(save-excursion
(org-drill-reschedule)))))))
(defun org-drill-entries (entries)
;; (defun org-drill-entries (entries)
;; "Returns nil, t, or a list of markers representing entries that were
;; 'failed' and need to be presented again before the session ends."
;; (let ((again-entries nil))
;; (setq *org-drill-done-entry-count* 0
;; *org-drill-pending-entry-count* (length entries))
;; (if (and org-drill-maximum-items-per-session
;; (> (length entries)
;; org-drill-maximum-items-per-session))
;; (setq entries (subseq entries 0
;; org-drill-maximum-items-per-session)))
;; (block org-drill-entries
;; (dolist (m entries)
;; (save-restriction
;; (switch-to-buffer (marker-buffer m))
;; (goto-char (marker-position m))
;; (setq result (org-drill-entry))
;; (cond
;; ((null result)
;; (message "Quit")
;; (return-from org-drill-entries nil))
;; ((eql result 'edit)
;; (setq end-pos (point-marker))
;; (return-from org-drill-entries nil))
;; (t
;; (cond
;; ((< result 3)
;; (push m again-entries))
;; (t
;; (decf *org-drill-pending-entry-count*)
;; (incf *org-drill-done-entry-count*)))
;; (when (and org-drill-maximum-duration
;; (> (- (float-time (current-time)) *org-drill-start-time*)
;; (* org-drill-maximum-duration 60)))
;; (message "This drill session has reached its maximum duration.")
;; (return-from org-drill-entries nil))))))
;; (or again-entries
;; t))))
(defun org-drill-entries-pending-p ()
(or *org-drill-again-entries*
(and (not (org-drill-maximum-item-count-reached-p))
(not (org-drill-maximum-duration-reached-p))
(or *org-drill-new-entries*
*org-drill-failed-entries*
*org-drill-mature-entries*
*org-drill-again-entries*))))
(defun org-drill-pending-entry-count ()
(+ (length *org-drill-new-entries*)
(length *org-drill-failed-entries*)
(length *org-drill-mature-entries*)
(length *org-drill-again-entries*)))
(defun org-drill-maximum-duration-reached-p ()
"Returns true if the current drill session has continued past its
maximum duration."
(and org-drill-maximum-duration
*org-drill-start-time*
(> (- (float-time (current-time)) *org-drill-start-time*)
(* org-drill-maximum-duration 60))))
(defun org-drill-maximum-item-count-reached-p ()
"Returns true if the current drill session has reached the
maximum number of items."
(and org-drill-maximum-items-per-session
(>= (length *org-drill-done-entries*)
org-drill-maximum-items-per-session)))
(defun org-drill-pop-next-pending-entry ()
(cond
;; First priority is items we failed in a prior session.
((and *org-drill-failed-entries*
(not (org-drill-maximum-item-count-reached-p))
(not (org-drill-maximum-duration-reached-p)))
(pop-random *org-drill-failed-entries*))
;; Next priority is newly added items, and items which
;; are not new and were not failed when they were last
;; reviewed.
((and (or *org-drill-new-entries*
*org-drill-mature-entries*)
(not (org-drill-maximum-item-count-reached-p))
(not (org-drill-maximum-duration-reached-p)))
(if (< (random (+ (length *org-drill-new-entries*)
(length *org-drill-mature-entries*)))
(length *org-drill-new-entries*))
(pop-random *org-drill-new-entries*)
;; else
(pop-random *org-drill-mature-entries*)))
;; After all the above are done, last priority is items
;; that were failed earlier THIS SESSION.
(*org-drill-again-entries*
(pop-random *org-drill-again-entries*))
(t
nil)))
(defun org-drill-entries ()
"Returns nil, t, or a list of markers representing entries that were
'failed' and need to be presented again before the session ends."
(let ((again-entries nil)
(*org-drill-done-entry-count* 0)
(*org-drill-pending-entry-count* (length entries)))
(if (and org-drill-maximum-items-per-session
(> (length entries)
org-drill-maximum-items-per-session))
(setq entries (subseq entries 0
org-drill-maximum-items-per-session)))
(block org-drill-entries
(dolist (m entries)
(save-restriction
(switch-to-buffer (marker-buffer m))
(goto-char (marker-position m))
(setq result (org-drill-entry))
(block org-drill-entries
(while (org-drill-entries-pending-p)
(setq m (org-drill-pop-next-pending-entry))
(unless m
(error "Unexpectedly ran out of pending drill items"))
(save-excursion
(set-buffer (marker-buffer m))
(goto-char m)
(setq result (org-drill-entry))
(cond
((null result)
(message "Quit")
(return-from org-drill-entries nil))
((eql result 'edit)
(setq end-pos (point-marker))
(return-from org-drill-entries nil))
((eql result 'skip)
nil) ; skip this item
(t
(cond
((null result)
(message "Quit")
(return-from org-drill-entries nil))
((eql result 'edit)
(setq end-pos (point-marker))
(return-from org-drill-entries nil))
((<= result org-drill-failure-quality)
(push m *org-drill-again-entries*))
(t
(cond
((< result 3)
(push m again-entries))
(t
(decf *org-drill-pending-entry-count*)
(incf *org-drill-done-entry-count*)))
(when (and org-drill-maximum-duration
(> (- (float-time (current-time)) *org-drill-start-time*)
(* org-drill-maximum-duration 60)))
(message "This drill session has reached its maximum duration.")
(return-from org-drill-entries nil))))))
(or again-entries
t))))
(push m *org-drill-done-entries*)))))))))
(defun org-drill-final-report ()
(read-char
(format
"%d items reviewed, %d items awaiting review
(read-char-exclusive
(format
"%d items reviewed
%d items awaiting review (%s, %s, %s)
Session duration %s
Recall of reviewed items:
Excellent (5): %3d%%
Good (4): %3d%%
Hard (3): %3d%%
Near miss (2): %3d%%
Failure (1): %3d%%
Total failure (0): %3d%%
Excellent (5): %3d%% | Near miss (2): %3d%%
Good (4): %3d%% | Failure (1): %3d%%
Hard (3): %3d%% | Total failure (0): %3d%%
Session finished. Press a key to continue..."
*org-drill-done-entry-count*
*org-drill-pending-entry-count*
(format-seconds "%h:%.2m:%.2s"
(- (float-time (current-time)) *org-drill-start-time*))
(round (* 100 (count 5 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 4 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 3 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 2 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 1 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 0 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
)))
(length *org-drill-done-entries*)
(org-drill-pending-entry-count)
(propertize
(format "%d failed"
(+ (length *org-drill-failed-entries*)
(length *org-drill-again-entries*)))
'face `(:foreground ,org-drill-failed-count-color))
(propertize
(format "%d old"
(length *org-drill-mature-entries*))
'face `(:foreground ,org-drill-mature-count-color))
(propertize
(format "%d new"
(length *org-drill-new-entries*))
'face `(:foreground ,org-drill-new-count-color))
(format-seconds "%h:%.2m:%.2s"
(- (float-time (current-time)) *org-drill-start-time*))
(round (* 100 (count 5 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 2 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 4 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 1 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 3 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 0 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
)))
@ -712,46 +1043,74 @@ agenda-with-archives
(interactive)
(let ((entries nil)
(failed-entries nil)
(new-entries nil)
(old-entries nil)
(result nil)
(results nil)
(end-pos nil))
(end-pos nil)
(cnt 0))
(block org-drill
(setq *org-drill-done-entries* nil
*org-drill-new-entries* nil
*org-drill-mature-entries* nil
*org-drill-failed-entries* nil
*org-drill-again-entries* nil)
(setq *org-drill-session-qualities* nil)
(setq *org-drill-start-time* (float-time (current-time)))
(save-excursion
(org-map-entries
(lambda () (when (org-drill-entry-due-p)
(cond
((org-drill-entry-new-p)
(push (point-marker) new-entries))
((<= (org-drill-entry-last-quality)
org-drill-failure-quality)
(push (point-marker) failed-entries))
(t
(push (point-marker) old-entries)))))
"" scope)
;; Failed first, then random mix of old + new
(setq entries (append (shuffle-list failed-entries)
(shuffle-list (append old-entries
new-entries))))
(cond
((null entries)
(message "I did not find any pending drill items."))
(t
(let ((again t))
(while again
(when (listp again)
(setq entries (shuffle-list again)))
(setq again (org-drill-entries entries))
(cond
((null again)
(return-from org-drill nil))
((eql t again)
(setq again nil))))
(message "Drill session finished!")
)))))
(unwind-protect
(save-excursion
(let ((org-trust-scanner-tags t))
(org-map-entries
(lambda ()
(when (zerop (% (incf cnt) 50))
(message "Processing drill items: %4d%s"
(+ (length *org-drill-new-entries*)
(length *org-drill-mature-entries*)
(length *org-drill-failed-entries*))
(make-string (ceiling cnt 50) ?.)))
(when (org-drill-entry-due-p)
(cond
((org-drill-entry-new-p)
(push (point-marker) *org-drill-new-entries*))
((and (org-drill-entry-last-quality)
(<= (org-drill-entry-last-quality)
org-drill-failure-quality))
(push (point-marker) *org-drill-failed-entries*))
(t
(push (point-marker) *org-drill-mature-entries*)))))
(concat "+" org-drill-question-tag) scope))
;; Failed first, then random mix of old + new
(setq entries (append (shuffle-list *org-drill-failed-entries*)
(shuffle-list (append *org-drill-mature-entries*
*org-drill-new-entries*))))
(cond
((and (null *org-drill-new-entries*)
(null *org-drill-failed-entries*)
(null *org-drill-mature-entries*))
(message "I did not find any pending drill items."))
(t
(org-drill-entries)
(message "Drill session finished!"))))
;; (cond
;; ((null entries)
;; (message "I did not find any pending drill items."))
;; (t
;; (let ((again t))
;; (while again
;; (when (listp again)
;; (setq entries (shuffle-list again)))
;; (setq again (org-drill-entries entries))
;; (cond
;; ((null again)
;; (return-from org-drill nil))
;; ((eql t again)
;; (setq again nil))))
;; (message "Drill session finished!")
;; ))))
(progn
(dolist (m (append *org-drill-new-entries*
*org-drill-failed-entries*
*org-drill-again-entries*
*org-drill-mature-entries*))
(free-marker m)))))
(cond
(end-pos
(switch-to-buffer (marker-buffer end-pos))
@ -761,15 +1120,25 @@ agenda-with-archives
(org-drill-final-report)))))
(defun org-drill-cram (&optional scope)
"Run an interactive drill session in 'cram mode'. In cram mode,
all drill items are considered to be due for review, unless they
have been reviewed within the last `org-drill-cram-hours'
hours."
(interactive)
(let ((*org-drill-cram-mode* t))
(org-drill scope)))
(add-hook 'org-mode-hook
(lambda ()
(if org-drill-use-visible-cloze-face-p
(font-lock-add-keywords
'org-mode
`((,org-drill-cloze-regexp
(0 'org-drill-visible-cloze-face nil)))
t))))
org-drill-cloze-keywords
t))))
(provide 'org-drill)

View file

@ -519,7 +519,7 @@ with a link to this URL."
"Preamble, to be inserted just after <body>. Set by publishing functions.
This may also be a function, building and inserting the preamble.")
(defvar org-export-html-postamble nil
"Preamble, to be inserted just before </body>. Set by publishing functions.
"Postamble, to be inserted just before </body>. Set by publishing functions.
This may also be a function, building and inserting the postamble.")
(defvar org-export-html-auto-preamble t
"Should default preamble be inserted? Set by publishing functions.")

View file

@ -515,7 +515,7 @@ List ending is determined by the indentation of text. See
(skip-chars-forward " \r\t\n")
(beginning-of-line))
((org-at-item-p)
(setq ind-ref (min ind ind-ref))
(setq ind-ref ind)
(forward-line 1))
((<= ind ind-ref)
(throw 'exit (point-at-bol)))
@ -1643,12 +1643,12 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is
(unless (and bullet-rule-p
(looking-at "\\S-")) '("*"))
;; Description items cannot be numbered
(unless (and bullet-rule-p
(or (eq org-plain-list-ordered-item-terminator ?.)
(org-at-item-description-p))) '("1)"))
(unless (and bullet-rule-p
(or (eq org-plain-list-ordered-item-terminator ?\))
(org-at-item-description-p))) '("1."))))
(org-at-item-description-p))) '("1."))
(unless (and bullet-rule-p
(or (eq org-plain-list-ordered-item-terminator ?.)
(org-at-item-description-p))) '("1)"))))
(len (length bullet-list))
(item-index (- len (length (member current bullet-list))))
(get-value (lambda (index) (nth (mod index len) bullet-list)))

View file

@ -578,18 +578,13 @@ See `org-publish-org-to' to the list of arguments."
"Publish a file with no transformation of any kind.
See `org-publish-org-to' to the list of arguments."
;; make sure eshell/cp code is loaded
(let* ((rel-dir
(file-relative-name
(file-name-directory filename)
(plist-get plist :base-directory)))
(pub-dir
(expand-file-name
(concat (file-name-as-directory pub-dir) rel-dir))))
(unless (file-directory-p pub-dir)
(make-directory pub-dir t))
(or (equal (expand-file-name (file-name-directory filename))
(file-name-as-directory (expand-file-name pub-dir)))
(copy-file filename pub-dir t))))
(copy-file filename
(expand-file-name (file-name-nondirectory filename) pub-dir)
t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Publishing files, sets of files, and indices
@ -606,13 +601,13 @@ See `org-publish-projects'."
(error "File %s not part of any known project"
(abbreviate-file-name filename)))))
(project-plist (cdr project))
(ftname (file-truename filename))
(ftname (expand-file-name filename))
(publishing-function
(or (plist-get project-plist :publishing-function)
'org-publish-org-to-html))
(base-dir
(file-name-as-directory
(file-truename
(expand-file-name
(or (plist-get project-plist :base-directory)
(error "Project %s does not have :base-directory defined"
(car project))))))
@ -799,7 +794,6 @@ directory and force publishing all files."
(interactive "P")
(when force
(org-publish-remove-all-timestamps))
;; (org-publish-initialize-files-alist force)
(save-window-excursion
(let ((org-publish-use-timestamps-flag
(if force nil org-publish-use-timestamps-flag)))

View file

@ -19303,7 +19303,9 @@ If there is no such heading, return nil."
(defun org-forward-same-level (arg &optional invisible-ok)
"Move forward to the arg'th subheading at same level as this one.
Stop at the first and last subheadings of a superior heading."
Stop at the first and last subheadings of a superior heading.
Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil
it wil also look at invisible ones."
(interactive "p")
(org-back-to-heading invisible-ok)
(org-on-heading-p)