From 3ad98da66708d3d1d5502099d01f101724a61ee9 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Fri, 17 Sep 2010 23:10:36 +0200 Subject: [PATCH 1/8] Update org-drill.el to version 1.4 --- contrib/lisp/org-drill.el | 809 +++++++++++++++++++++++++++----------- 1 file changed, 589 insertions(+), 220 deletions(-) diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el index a96916e4b..6b5ff0654 100644 --- a/contrib/lisp/org-drill.el +++ b/contrib/lisp/org-drill.el @@ -1,7 +1,7 @@ ;;; org-drill.el - Self-testing with org-learn ;;; ;;; Author: Paul Sexton -;;; 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) From 2fcd20e6eb0b72ac79e602e61e7af1ee83afb940 Mon Sep 17 00:00:00 2001 From: Sebastian Rose Date: Sat, 18 Sep 2010 03:18:42 +0000 Subject: [PATCH 2/8] Bug: Inconsistency with org-publish-attachment Aidan Gauland writes: > Sebastian Rose gmx.de> writes: >> did you revert the previous patch? The second patch was against master >> again. > > I ran git reset --hard then applied the second patch. > >> I changed to a subdirectory of my :base-directory (here $BASE): >> >> $ cd ${BASE}/subdirectory >> $ cp ~/images/first.jpg . # a simple image >> $ ln -s ~/images/second.jpg # a link to an image >> $ ln -s ~/images/screenshots/ # a link to a directory >> >> When exporting, I get this tree in :publishing-directory ($PUB): >> >> $PUB/ >> |-- subdirectory/ >> | |-- first.jpg >> | |-- second.jpg >> | `-- screenshots/ >> | |-- some.png >> | `-- other.png >> >> which is what you expected, is that right? > > Yes, that's what I expected. What I'm getting is a little different. > > $PUB/ > `-- subdirectory/ > |-- screenshots/ > | `-- subdirectory/ > | `-- screenshots/ > | |-- other.png > | `-- some.png > `-- subdirectory/ > |-- first.jpg > |-- second.jpg > > This is how the project is defined... > (setq > org-publish-project-alist > '(("static" > :base-directory "~/org-bug/" > :publishing-directory "~/org-bug-pub/" > :publishing-function org-publish-attachment > :recursive t > :base-extension "css\\|gz\\|bz\\|lzma\\|jpg\\|gif\\|png"))) > > And published with this sexp. > (org-publish "static") > > Perhaps the discrepancy between our setups is git commit (not sure if > I'm using the right terms there)? git log shows > 878d94b47225729bfffaca9c57a5bdeb344a8ffb at the top of its output. > > Thanks for your help! > --Aidan Ahrrgh :) I just pulled, because I couldn't find that commit. That commit already includes the (obviously wrong) first patch... Here's the patch that reverts the first attempt and applies the new one. Hope this works :) Sebastian --- lisp/org-publish.el | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/lisp/org-publish.el b/lisp/org-publish.el index 753452474..331e8eca4 100644 --- a/lisp/org-publish.el +++ b/lisp/org-publish.el @@ -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)))))) From 9d1c7bf10031c9946ce92f70047bc7941c335978 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Sat, 18 Sep 2010 05:56:11 +0200 Subject: [PATCH 3/8] Changes_old.org: use #+begin_example instead of #+begin_src. When republishing all from scratch with babel code evaluation turned on, Changes_old.org could not be exported because #+STARTUP: indent returns an error when run in Emacs 23.1. --- ORGWEBPAGE/Changes_old.org | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ORGWEBPAGE/Changes_old.org b/ORGWEBPAGE/Changes_old.org index bdcb6d5d5..f2bfaccb9 100644 --- a/ORGWEBPAGE/Changes_old.org +++ b/ORGWEBPAGE/Changes_old.org @@ -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 From 3abcc57aa956fee3dad7cf3bf5a67d784de4141b Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Sat, 18 Sep 2010 07:23:16 +0200 Subject: [PATCH 4/8] Document INVISIBLE-OK argument of `org-forward-same-level' * lisp/org.el (org-forward-same-level): Fix docstring. --- lisp/org.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index ea0fb0904..64e620f7a 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -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) From cb543166e298bdb1a000a997f4734ae241aae71c Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Sat, 18 Sep 2010 17:57:17 +0200 Subject: [PATCH 5/8] Reformat paragraph - workaround for a bug in org-list-maybe-skip-block. --- ORGWEBPAGE/Changes_old.org | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/ORGWEBPAGE/Changes_old.org b/ORGWEBPAGE/Changes_old.org index f2bfaccb9..492acbd83 100644 --- a/ORGWEBPAGE/Changes_old.org +++ b/ORGWEBPAGE/Changes_old.org @@ -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 From 7ec0cceba49bf4249f8c02049be9ce6c93443f6c Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Sat, 18 Sep 2010 18:10:34 +0200 Subject: [PATCH 6/8] org-export-html-postamble: fix docstring. --- lisp/org-html.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 1a96fa12c..2d225beff 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -519,7 +519,7 @@ with a link to this URL." "Preamble, to be inserted just after . 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 . Set by publishing functions. + "Postamble, to be inserted just before . 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.") From cf5fbad49b3e23a40158fdb832dd44eedbc82340 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Sat, 18 Sep 2010 18:44:44 +0200 Subject: [PATCH 7/8] org-publish-all: remove outdated comment. --- lisp/org-publish.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/org-publish.el b/lisp/org-publish.el index 331e8eca4..2b85aa681 100644 --- a/lisp/org-publish.el +++ b/lisp/org-publish.el @@ -794,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))) From da92f40876942b4117b65695f3da3ad4feffd80a Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 18 Sep 2010 19:39:04 +0200 Subject: [PATCH 8/8] Correct LaTeX export with sublists. Minor fix of bullet cycling. * org-list.el (org-cycle-list-bullet): follow order of bullets indicated in doc-string. * org-list.el (org-list-bottom-point-with-indent): list is ended when a line is less indented that the last item, not the less indented item. --- lisp/org-list.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index d9fc24e77..e5f607cc6 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -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)))