diff options
Diffstat (limited to 'org-fc.el')
| -rw-r--r-- | org-fc.el | 433 |
1 files changed, 4 insertions, 429 deletions
@@ -78,11 +78,6 @@ Used to generate absolute paths to the awk scripts.") :type 'string :group 'org-fc) -(defcustom org-fc-cloze-type-property "FC_CLOZE_TYPE" - "Property used to store the card's subtype for cloze cards." - :type 'string - :group 'org-fc) - (defcustom org-fc-created-property "FC_CREATED" "Property used to store the cards creation time." :type 'string @@ -93,11 +88,6 @@ Used to generate absolute paths to the awk scripts.") :type 'string :group 'org-fc) -(defcustom org-fc-type-cloze-type-property "FC_CLOZE_TYPE" - "Name of the property to use for storing the cloze subtype." - :type 'string - :group 'org-fc) - (defcustom org-fc-suspended-tag "suspended" "Tag for marking suspended cards." :type 'string @@ -235,11 +225,6 @@ Does not apply to cloze single and cloze enumeration cards." ;;;; Font Faces -(defface org-fc-type-cloze-hole-face - '((t (:bold t))) - "Face for org-fc cloze card holes." - :group 'org-fc) - ;; Based on `magit-diff-added' (defface org-fc-diff-correct `((((class color) (background light)) @@ -599,420 +584,10 @@ Argument UPDATE-FN Function to update a card when it's contents have changed." (cl-third entry) (error "No such flashcard type: %s" type)))) -;;;; Normal - -(defun org-fc-type-normal-init () - "Mark headline as card of the normal type." - (interactive) - (org-fc--init-card "normal") - (org-fc-review-data-update '("front"))) - -(defun org-fc-type-normal-setup (_position) - "Prepare a normal card for review." - (interactive) - ;; Make sure the card is collapsed - (outline-hide-subtree) - (when (org-fc-has-back-heading-p) - (org-show-entry) - ;; Make sure the back heading is visible - (org-fc-with-point-at-back-heading - (org-show-set-visibility 'minimal)))) - -(defun org-fc-type-normal-flip () - "Flip a normal card." - (interactive) - (org-show-entry) - (org-show-children) - ;; NOTE: the body only runs if the card has a back heading - (org-fc-with-point-at-back-heading - (org-show-entry) - (org-show-children) - (org-fc-show-latex))) - -(org-fc-register-type - 'normal - 'org-fc-type-normal-setup - 'org-fc-type-normal-flip - 'org-fc-noop) - -;;;; Double - -(defvar org-fc-type-double--overlay '()) - -(defun org-fc-type-double-init () - "Mark headline as card of the double type." - (interactive) - (org-fc--init-card "double") - (org-fc-review-data-update '("front" "back"))) - -(defun org-fc-type-double-setup (position) - "Prepare POSITION of a double card for review." - (pcase position - ("front" (org-fc-type-normal-setup position)) - ("back" - (outline-hide-subtree) - (if (org-fc-has-back-heading-p) - (org-fc-with-point-at-back-heading - (org-fc-show-latex) - (outline-show-entry)) - (org-show-entry) - (setq org-fc-type-double--overlay (org-fc-hide-heading "[...]")))) - (_ (error "Invalid double position %s" position)))) - -(defun org-fc-type-double-flip () - "Flip a double card." - (if org-fc-type-double--overlay - (delete-overlay org-fc-type-double--overlay)) - (org-show-entry) - (org-show-children) - (org-fc-with-point-at-back-heading - (org-show-entry) - (org-show-children) - (org-fc-show-latex))) - -(org-fc-register-type - 'double - 'org-fc-type-double-setup - 'org-fc-type-double-flip - 'org-fc-noop) - -;;;; Text-Input - -(defun org-fc-text-input-content () - "Return the first line of a cards (back) contents. -Returns a pair (pos . string). If the card has a 'Back' heading, -its content is used, otherwise, the main content is used. This -function is expected to be called with point on a heading." - (save-excursion - ;; Go to main or "Back" heading - (if-let ((pos (org-fc-back-heading-position))) - (goto-char pos)) - - ;; Skip metadata & drawers - (forward-line) - (while (or (looking-at-p org-scheduled-regexp) - (looking-at-p org-deadline-regexp)) - (forward-line)) - (while (looking-at org-drawer-regexp) - (if (re-search-forward ":END:" nil t) - (forward-line) - (error "No :END: found for drawer"))) - (unless (looking-at-p org-heading-regexp) - (cons - (point) - (buffer-substring-no-properties (point) (point-at-eol)))))) - -(defun org-fc-type-text-input-init () - "Mark headline as card of the text-input type." - (interactive) - (unless (org-fc-text-input-content) - (error "Card contains content")) - (org-fc--init-card "text-input") - (org-fc-review-data-update '("front"))) - -(defun org-fc-type-text-input-setup (_position) - "Prepare a text-input card for review." - (interactive) - ;; Hide answer - (outline-hide-subtree) - (when (org-fc-has-back-heading-p) - (org-show-entry) - (org-fc-with-point-at-back-heading (org-show-set-visibility 'minimal))) - ;; Prompt user, create diff overlay - (let* ((pos-content (org-fc-text-input-content)) - (content (cdr pos-content)) - (start (car pos-content)) - (end (+ start (length content))) - (deemph (org-fc-deemphasize content)) - (diff (org-fc-diff (read-string "Answer: ") (cdr deemph)))) - ;; Overlay for user input - (when (car deemph) - (setq start (1+ start)) - (setq end (1- end))) - (org-fc-hide-region start end (car diff)) - ;; Overlay for expected answer, using the newline after the answer - (if (cdr diff) - (org-fc-hide-region - end (1+ end) - (concat - " (expected: " - (if (null (car deemph)) - (cdr diff) - (org-fc-emphasize - (concat (car deemph) (cdr diff) (car deemph)))) - ")\n")))) - ;; Reveal answer & diff - (save-excursion - (org-show-entry) - (org-show-children) - (org-fc-with-point-at-back-heading - (org-show-entry) - (org-show-children) - (org-fc-show-latex)))) - -(org-fc-register-type - 'text-input - 'org-fc-type-text-input-setup - nil - 'org-fc-noop) - -;;;; Vocab - -(defcustom org-fc-type-vocab-slow-speed 0.7 - "Speed to use for slow playback.") - -(defcustom org-fc-type-vocab-audio-property "FC_VOCAB_AUDIO" - "Property with path to audio file.") - -(defun org-fc-type-vocab-init () - "Mark headline as card of the vocab type." - (interactive) - (org-fc--init-card "vocab") - (org-fc-review-data-update '("front" "back"))) - -(defun org-fc-type-vocab-setup (position) - "Prepare POSITION of a vocab card for review." - (pcase position - ("front" - (org-fc-audio-play org-fc-type-vocab-audio-property) - (org-fc-type-normal-setup position)) - ("back" - (org-fc-type-vocab-typing-setup) - (org-fc-audio-play org-fc-type-vocab-audio-property) - 'rate) - (_ (error "Invalid vocab position %s" position)))) - -(defun org-fc-type-vocab-flip () - "Flip a vocab card." - (org-fc-type-normal-flip)) - -(defun org-fc-type-vocab-play () - "Play vocab audio file at normal speed." - (interactive) - (org-fc-audio-play org-fc-type-vocab-audio-property)) - -(defun org-fc-type-vocab-play-slow () - "Play vocab audio file at slow speed." - (interactive) - (org-fc-audio-play org-fc-type-vocab-audio-property org-fc-type-vocab-slow-speed)) - -(defun org-fc-vocab-content () - "Heading position & text as a (pos . string) pair." - (save-excursion - (org-fc-goto-entry-heading) - (let ((case-fold-search nil)) - (if (looking-at org-complex-heading-regexp) - (cons - (match-beginning 4) - (buffer-substring-no-properties (match-beginning 4) (match-end 4))))))) - -(defun org-fc-type-vocab-typing-setup () - "Prepare a text-input vocab card for review." - (interactive) - (org-show-subtree) - (let* ((pos-content (org-fc-vocab-content)) - (content (cdr pos-content)) - (start (car pos-content)) - (end (+ start (length content))) - (ov (org-fc-hide-region start end "...")) - (deemph (org-fc-deemphasize content)) - (diff (org-fc-diff (read-string "Answer: ") (cdr deemph)))) - (delete-overlay ov) - ;; Overlay for user input - (when (car deemph) - (setq start (1+ start)) - (setq end (1- end))) - (org-fc-hide-region start end (car diff)) - ;; Overlay for expected answer, using the newline after the answer - (if (cdr diff) - (org-fc-hide-region - end (1+ end) - (concat - "\n! " - (if (null (car deemph)) - (cdr diff) - (org-fc-emphasize - (concat (car deemph) (cdr diff) (car deemph)))) - ""))))) - -(org-fc-register-type - 'vocab - 'org-fc-type-vocab-setup - 'org-fc-type-vocab-flip - 'org-fc-noop) - -;;;; Cloze - -;; NOTE: The context type is not implemented yet -(defvar org-fc-type-cloze-types - '(deletion enumeration context single) - "List of valid cloze card subtypes.") - -(defvar org-fc-type-cloze--text '() - "Text overlay.") -(defvar org-fc-type-cloze--hint '() - "Hint overlay.") - -(defcustom org-fc-type-cloze-context 1 - "Number of surrounding cards to show for 'context' type cards." - :type 'number - :group 'org-fc) - -;;;;; Hole Parsing / Hiding - -(defvar org-fc-type-cloze-hole-re - (rx - (seq - "{{" - (group-n 1 (* (or (seq "$" (+ (not (any "$"))) "$") - (not (any "}"))))) "}" - (? (seq "{" (group-n 2 (* (or (seq "$" (not (any "$")) "$") - (not (any "}"))))) "}")) - (? "@" (group-n 3 (+ digit))) - "}")) - "Regexp for a cloze holes.") - -(defun org-fc-type-cloze-max-hole-id () - "Get the max-hole property of the heading at point." - (if-let ((max-id (org-entry-get (point) org-fc-type-cloze-max-hole-property))) - (string-to-number max-id) - -1)) - -(defun org-fc-type-cloze--parse-holes (current-position end) - "Starting at point, collect all cloze holes before END. -CURRENT-POSITION is the id of the hole being reviewed. Returns a -pair (holes . current-index) where current-index is the index of -the hole for the current position." - (let (holes current-index) - (while (re-search-forward org-fc-type-cloze-hole-re end t) - (when (match-beginning 3) - (push (match-data) holes) - (if (= current-position (string-to-number (match-string 3))) - (setq current-index (1- (length holes)))))) - (cons (reverse holes) current-index))) - -(defun org-fc-type-cloze--hole-visible-p (type i current-index) - "Determine whether hole I of card TYPE should be visible based. -CURRENT-INDEX is the index of the current position in the list of all holes." - (cl-case type - ('enumeration (< i current-index)) - ('deletion t) - ('single nil) - ('context (<= (abs (- i current-index)) org-fc-type-cloze-context)) - (t (error "Org-fc: Unknown cloze card type %s" type)))) - -(defun org-fc-type-cloze--end () - "End of contents of heading at point, excluding subheadings." - (save-excursion - ;; If there is no next heading, we end up at `(point-max)` - (outline-next-heading) - (1- (point)))) - -(defun org-fc-type-cloze-hide-holes (position) - "Hide holes of a card of TYPE in relation to POSITION." - (org-fc-with-point-at-entry - (let* ((type (intern (org-entry-get (point) org-fc-type-cloze-type-property))) - (end (org-fc-type-cloze--end)) - (holes-index (org-fc-type-cloze--parse-holes position end)) - (holes (car holes-index)) - (current-index (cdr holes-index))) - (cl-loop - for i below (length holes) - for (hole-beg hole-end text-beg text-end hint-beg hint-end) in holes - do - (progn - ;; Fake position if there is no hint - (unless hint-beg (setq hint-beg text-end)) - (unless hint-end (setq hint-end text-end)) - (cond - ;; If the hole is the one currently being reviewed, hide all - ;; the hole markup, hide the answer, format the hint as - ;; "[...hint]" and set the font for the whole hole. - ((= i current-index) - (org-fc-hide-region hole-beg text-beg "") - (remove-overlays text-beg text-end) - (setq org-fc-type-cloze--text - (org-fc-make-overlay text-beg text-end 'invisible t)) - (org-fc-hide-region text-end hint-beg "") - (setq org-fc-type-cloze--hint - (org-fc-overlay-surround - (org-fc-make-overlay hint-beg hint-end) - "[..." "]" 'org-fc-type-cloze-hole-face)) - (org-fc-hide-region hint-end hole-end "") - (org-fc-make-overlay - hole-beg hole-end - 'face 'org-fc-type-cloze-hole-face)) - ;; If the text of another hole should be visible, - ;; hide the hole markup and the hint - ((org-fc-type-cloze--hole-visible-p type i current-index) - (org-fc-hide-region hole-beg text-beg) - (org-fc-hide-region text-end hole-end)) - ;; If the text of another hole should not be visible, - ;; hide the whole hole - (t (org-fc-hide-region hole-beg hole-end "...")))))))) - -;;;;; Setup / Flipping - -(defun org-fc-type-cloze-init (type) - "Initialize the current heading for use as a cloze card of subtype TYPE. -Processes all holes in the card text." - (interactive (list - (intern - (completing-read "Cloze Type: " org-fc-type-cloze-types)))) - (unless (member type org-fc-type-cloze-types) - (error "Invalid cloze card type: %s" type)) - (org-fc--init-card "cloze") - (org-fc-type-cloze-update) - (org-set-property org-fc-type-cloze-type-property (format "%s" type))) - -(defun org-fc-type-cloze-setup (position) - "Prepare POSITION of a cloze card for review." - (setq org-fc-type-cloze--text nil) - (setq org-fc-type-cloze--hint nil) - (outline-hide-subtree) - (org-show-entry) - (org-fc-type-cloze-hide-holes (string-to-number position))) - -(defun org-fc-type-cloze-flip () - "Flip a cloze card." - (org-show-children) - (overlay-put org-fc-type-cloze--text 'invisible nil) - (org-fc-show-latex) - ;; Remove all overlays in the region of the hint to get rid of - ;; latex overlays in the hint, then hide the region again. - (let* ((hint-start (overlay-start org-fc-type-cloze--hint)) - (hint-end (overlay-end org-fc-type-cloze--hint))) - (remove-overlays hint-start hint-end) - (org-fc-hide-region hint-start hint-end))) - -(defun org-fc-type-cloze-update () - "Update the review data & deletions of the current heading." - (let* ((end (org-fc-type-cloze--end)) - (hole-id (1+ (org-fc-type-cloze-max-hole-id))) - ids) - (save-excursion - (while (re-search-forward org-fc-type-cloze-hole-re end t) - (let ((id (match-string 3)) - (hole-end (match-end 0))) - (unless id - (setq id hole-id) - (cl-incf hole-id 1) - (let ((id-str (number-to-string id))) - (cl-incf end (+ 1 (length id-str))) - (goto-char hole-end) - (backward-char) - (insert "@" id-str))) - (push (format "%s" id) ids)))) - (org-set-property - org-fc-type-cloze-max-hole-property - (format "%s" (1- hole-id))) - (org-fc-review-data-update (reverse ids)))) - -(org-fc-register-type - 'cloze - 'org-fc-type-cloze-setup - 'org-fc-type-cloze-flip - 'org-fc-type-cloze-update) +(require 'org-fc-type-normal) +(require 'org-fc-type-double) +(require 'org-fc-type-text-input) +(require 'org-fc-type-cloze) ;;; Working with Overlays / Hiding Text ;;;; Showing / Hiding Overlays |