summaryrefslogtreecommitdiff
path: root/org-fc-review.el
diff options
context:
space:
mode:
Diffstat (limited to 'org-fc-review.el')
-rw-r--r--org-fc-review.el375
1 files changed, 0 insertions, 375 deletions
diff --git a/org-fc-review.el b/org-fc-review.el
deleted file mode 100644
index 67f9ef4..0000000
--- a/org-fc-review.el
+++ /dev/null
@@ -1,375 +0,0 @@
-;;; org-fc-review.el --- Review of due headlines / positions -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2020 Leon Rische
-
-;; Author: Leon Rische <emacs@leonrische.me>
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Cards are reviewed by
-;; 1. opening the file they are in
-;; 2. calling the setup function for the card type
-;; 3. opening a hydra for flipping the card
-;; 4. calling the flip function for the card type
-;; 5. opening a hydra for rating the card
-;; 6. updating the review data based on the rating
-;;
-;;; Code:
-
-(require 'org-fc-sm2)
-
-;;;; Customization
-
-(defcustom org-fc-review-data-drawer "REVIEW_DATA"
- "Name of the drawer used to store review data."
- :type 'string
- :group 'org-fc)
-
-;;;; Session Management
-
-(defclass org-fc-review-session ()
- ((current-item :initform nil)
- (ratings :initform nil :initarg :ratings)
- (cards :initform nil :initarg :cards)))
-
-(defun org-fc-make-review-session (cards)
- "Create a new review session with CARDS."
- (make-instance
- 'org-fc-review-session
- :ratings
- (if-let ((stats (org-fc-awk-stats-reviews)))
- (plist-get stats :day)
- '(:total 0 :again 0 :hard 0 :good 0 :easy 0))
- :cards cards))
-
-(defun org-fc-session-cards-pending-p (session)
- "Check if there are any cards in SESSION."
- (not (null (oref session cards))))
-
-(defun org-fc-session-pop-next-card (session)
- "Remove and return one card from SESSION."
- (let ((card (pop (oref session cards))))
- (setf (oref session current-item) card)
- card))
-
-(defun org-fc-session-add-rating (session rating)
- "Store RATING in the review history of SESSION."
- (with-slots (ratings) session
- (case rating
- ('again (incf (getf ratings :again) 1))
- ('hard (incf (getf ratings :hard) 1))
- ('good (incf (getf ratings :good) 1))
- ('easy (incf (getf ratings :easy) 1)))
- (incf (getf ratings :total 1))))
-
-(defun org-fc-session-stats-string (session)
- "Generate a string with review stats for SESSION."
- (with-slots (ratings) session
- (let ((total (plist-get ratings :total)))
- (if (plusp total)
- (format "%.2f again, %.2f hard, %.2f good, %.2f easy"
- (/ (* 100.0 (plist-get ratings :again)) total)
- (/ (* 100.0 (plist-get ratings :hard)) total)
- (/ (* 100.0 (plist-get ratings :good)) total)
- (/ (* 100.0 (plist-get ratings :easy)) total))
- "No ratings yet"))))
-
-(defvar org-fc-review--current-session nil
- "Current review session.")
-
-;;;; Helper Functions
-
-(defun org-fc-review-next-time (next-interval)
- "Generate an `org-mode' timestamp NEXT-INTERVAL days from now."
- (let ((seconds (* next-interval 60 60 24))
- (now (time-to-seconds)))
- (format-time-string
- org-fc-timestamp-format
- (seconds-to-time (+ now seconds))
- "UTC0")))
-
-;; File-scoped variant of `org-id-goto'
-(defun org-fc-id-goto (id file)
- "Go to the heading with ID in FILE."
- (let ((position (org-id-find-id-in-file id file)))
- (if position
- (goto-char (cdr position))
- (error "ID %s not found in %s" id file))))
-
-;;;; Reviewing Cards
-
-(defun org-fc-review--context (context)
- "Start a review session for all cards in CONTEXT."
- (if org-fc-review--current-session
- (message "Flashcards are already being reviewed")
- (let ((cards (org-fc-due-positions context)))
- (if (null cards)
- (message "No cards due right now")
- (progn
- (setq org-fc-review--current-session
- (org-fc-make-review-session cards))
- (org-fc-review-next-card))))))
-
-;;;###autoload
-(defun org-fc-review-buffer ()
- "Review due cards in the current buffer."
- (interactive)
- (org-fc-review--context 'buffer))
-
-;;;###autoload
-(defun org-fc-review-all ()
- "Review all due cards."
- (interactive)
- (org-fc-review--context 'all))
-
-(defun org-fc-review-next-card ()
- "Review the next card of the current session."
- (if (org-fc-session-cards-pending-p org-fc-review--current-session)
- (condition-case err
- (let* ((card (org-fc-session-pop-next-card org-fc-review--current-session))
- (path (plist-get card :path))
- (id (plist-get card :id))
- (type (plist-get card :type))
- (position (plist-get card :position))
- ;; Prevent messages from hiding the multiple-choice card dialog
- (inhibit-message t))
- (let ((buffer (find-buffer-visiting path)))
- (with-current-buffer (find-file path)
- ;; If buffer was already open, don't kill it after rating the card
- (if buffer
- (setq-local org-fc-reviewing-existing-buffer t)
- (setq-local org-fc-reviewing-existing-buffer nil))
- (goto-char (point-min))
- (org-fc-show-all)
- (org-fc-id-goto id path)
- ;; Make sure the headline the card is in is expanded
- (org-reveal)
- (org-fc-narrow-tree)
- (org-fc-hide-drawers)
- (org-fc-show-latex)
- (setq org-fc-timestamp (time-to-seconds (current-time)))
- (funcall (org-fc-type-setup-fn type) position))))
- (error
- (message "Error during review: %s" (error-message-string err))
- (org-fc-review-quit)))
- (message "Review Done")
- (org-fc-review-quit)))
-
-(defhydra org-fc-review-rate-hydra (:foreign-keys warn)
- "
-%(length (oref org-fc-review--current-session cards)) cards remaining
-%s(org-fc-session-stats-string org-fc-review--current-session)
-
-"
- ("a" (org-fc-review-rate-card 'again) "Rate as again" :exit t)
- ("h" (org-fc-review-rate-card 'hard) "Rate as hard" :exit t)
- ("g" (org-fc-review-rate-card 'good) "Rate as good" :exit t)
- ("e" (org-fc-review-rate-card 'easy) "Rate as easy" :exit t)
- ("q" org-fc-review-quit "Quit" :exit t))
-
-(defhydra org-fc-review-flip-hydra (:foreign-keys warn)
- "
-%(length (oref org-fc-review--current-session cards)) cards remaining
-%s(org-fc-session-stats-string org-fc-review--current-session)
-
-"
- ("RET" org-fc-review-flip "Flip" :exit t)
- ("t" org-fc-tag-card "Add Tag")
- ;; Neo-Layout ergonomics
- ("n" org-fc-review-flip "Flip" :exit t)
- ("q" org-fc-review-quit "Quit" :exit t))
-
-(defmacro org-fc-review-with-current-item (var &rest body)
- "Evaluate BODY with the current card bound to VAR.
-Before evaluating BODY, check if the heading at point has the
-same ID as the current card in the session."
- (declare (indent defun))
- `(if org-fc-review--current-session
- (if-let ((,var (oref org-fc-review--current-session current-item)))
- (if (string= (plist-get ,var :id) (org-id-get))
- (progn ,@body)
- (message "Flashcard ID mismatch"))
- (message "No flashcard review is in progress"))))
-
-(defun org-fc-review-flip ()
- "Flip the current flashcard."
- (interactive)
- (condition-case err
- (org-fc-review-with-current-item card
- (let ((type (plist-get card :type)))
- (funcall (org-fc-type-flip-fn type))))
- (error
- (message "Error flipping card: %s" (error-message-string err))
- (org-fc-review-quit))))
-
-;; TODO: Remove -card suffix
-(defun org-fc-review-rate-card (rating)
- "Rate the card at point with RATING."
- (interactive)
- (condition-case err
- (org-fc-review-with-current-item card
- (let* ((path (plist-get card :path))
- (id (plist-get card :id))
- (position (plist-get card :position))
- (now (time-to-seconds (current-time)))
- (delta (- now org-fc-timestamp)))
- (org-fc-session-add-rating org-fc-review--current-session rating)
- (org-fc-review-update-data path id position rating delta)
- (org-fc-show-all)
- (save-buffer)
- (unless org-fc-reviewing-existing-buffer
- (kill-buffer))
- (org-fc-review-next-card)))
- (error
- (message "Error rating card: %s" (error-message-string err))
- (org-fc-review-quit))))
-
-(defun org-fc-review-update-data (path id position rating delta)
- "Update the review data of the card.
-Also add a new entry in the review history file. PATH, ID,
-POSITION identify the position that was reviewed, RATING is a
-review rating and DELTA the time in seconds between showing and
-rating the card."
- (save-excursion
- (org-fc-goto-entry-heading)
- (let* ((data (org-fc-get-review-data))
- (current (assoc position data #'string=)))
- (unless current
- (error "No review data found for this position"))
- (unless (and (boundp 'org-fc-demo-mode) org-fc-demo-mode)
- (let ((ease (string-to-number (second current)))
- (box (string-to-number (third current)))
- (interval (string-to-number (fourth current))))
- (org-fc-review-history-add
- (list
- (org-fc-timestamp-now)
- path
- id
- position
- (format "%.2f" ease)
- (format "%d" box)
- (format "%.2f" interval)
- (symbol-name rating)
- (format "%.2f" delta)))
- (destructuring-bind (next-ease next-box next-interval)
- (org-fc-sm2-next-parameters ease box interval rating)
- (setcdr
- current
- (list (format "%.2f" next-ease)
- (number-to-string next-box)
- (format "%.2f" next-interval)
- (org-fc-review-next-time next-interval)))
- (org-fc-set-review-data data)))))))
-
-;;;###autoload
-(defun org-fc-review-quit ()
- "Quit the review, remove all overlays from the buffer."
- (interactive)
- (setq org-fc-review--current-session nil)
- (org-fc-show-all))
-
-;;;; Writing Review History
-
-(defun org-fc-review-history-add (elements)
- "Add ELEMENTS to the history csv file."
- (append-to-file
- (concat
- (mapconcat #'identity elements "\t")
- "\n")
- nil
- org-fc-review-history-file))
-
-;;;; Reading / Writing Review Data
-
-;; Based on `org-log-beginning'
-(defun org-fc-review-data-position (&optional create)
- "Return (BEGINNING . END) points of the review data drawer.
-When optional argument CREATE is non-nil, the function creates a
-drawer, if necessary. Returned position ignores narrowing.
-
-BEGINNING is the start of the first line inside the drawer,
-END is the start of the line with :END: on it."
- (org-with-wide-buffer
- (org-end-of-meta-data)
- (let ((regexp (concat "^[ \t]*:" (regexp-quote org-fc-review-data-drawer) ":[ \t]*$"))
- (end (if (org-at-heading-p) (point)
- (save-excursion (outline-next-heading) (point))))
- (case-fold-search t))
- (catch 'exit
- ;; Try to find existing drawer.
- (while (re-search-forward regexp end t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'drawer)
- (throw 'exit
- (cons (org-element-property :contents-begin element)
- (org-element-property :contents-end element))))))
- ;; No drawer found. Create one, if permitted.
- (when create
- (unless (bolp) (insert "\n"))
- (let ((beg (point)))
- (insert ":" org-fc-review-data-drawer ":\n:END:\n")
- (org-indent-region beg (point)))
- (cons
- (line-beginning-position 0)
- (line-beginning-position 0)))))))
-
-(defun org-fc-get-review-data ()
- "Get a cards review data as a Lisp object."
- (let ((position (org-fc-review-data-position nil)))
- (if position
- (save-excursion
- (goto-char (car position))
- (cddr (org-table-to-lisp))))))
-
-(defun org-fc-set-review-data (data)
- "Set the cards review data to DATA."
- (save-excursion
- (let ((position (org-fc-review-data-position t)))
- (kill-region (car position) (cdr position))
- (goto-char (car position))
- (insert "| position | ease | box | interval | due |\n")
- (insert "|-|-|-|-|-|\n")
- (loop for datum in data do
- (insert
- "| "
- (mapconcat (lambda (x) (format "%s" x)) datum " | ")
- " |\n"))
- (org-table-align))))
-
-(defun org-fc-review-data-default (position)
- "Default review data for position POSITION."
- (list position org-fc-sm2-ease-initial 0 0
- (org-fc-timestamp-now)))
-
-(defun org-fc-review-data-update (positions)
- "Update review data to POSITIONS.
-If a doesn't exist already, it is initialized with default
-values. Entries in the table not contained in POSITIONS are
-removed."
- (let ((old-data (org-fc-get-review-data)))
- (org-fc-set-review-data
- (mapcar
- (lambda (pos)
- (or
- (assoc pos old-data #'string=)
- (org-fc-review-data-default pos)))
- positions))))
-
-;;;; Footer
-
-(provide 'org-fc-review)
-
-;;; org-fc-review.el ends here