diff options
| -rw-r--r-- | org-fc-awk.el | 2 | ||||
| -rw-r--r-- | org-fc-type-cloze.el | 211 | ||||
| -rw-r--r-- | org-fc-type-double.el | 73 | ||||
| -rw-r--r-- | org-fc-type-normal.el | 65 | ||||
| -rw-r--r-- | org-fc-type-text-input.el | 109 | ||||
| -rw-r--r-- | org-fc-type-vocab.el | 126 | ||||
| -rw-r--r-- | org-fc.el | 433 |
7 files changed, 589 insertions, 430 deletions
diff --git a/org-fc-awk.el b/org-fc-awk.el index 6e23b31..9c9d89b 100644 --- a/org-fc-awk.el +++ b/org-fc-awk.el @@ -38,7 +38,7 @@ With the '-L' option, 'find' follows symlinks." `(("fc_tag" . ,org-fc-flashcard-tag) ("suspended_tag" . ,org-fc-suspended-tag) ("type_property" . ,org-fc-type-property) - ("cloze_type_property" . ,org-fc-cloze-type-property) + ("cloze_type_property" . ,org-fc-type-cloze-type-property) ("created_property" . ,org-fc-created-property) ("review_data_drawer" . ,org-fc-review-data-drawer))) diff --git a/org-fc-type-cloze.el b/org-fc-type-cloze.el new file mode 100644 index 0000000..5774d8b --- /dev/null +++ b/org-fc-type-cloze.el @@ -0,0 +1,211 @@ +;;; org-fc-type-cloze.el --- Cloze deletion card type -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Leon Rische + +;; Author: Leon Rische <emacs@leonrische.me> +;; Url: https://www.leonrische.me/pages/org_flashcards.html +;; Package-requires: ((emacs "26.3") (org "9.3")) +;; Version: 0.0.1 + +;; 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: +;; +;;; Code: + +(defcustom org-fc-type-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-type-cloze-context 1 + "Number of surrounding cards to show for 'context' type cards." + :type 'number + :group 'org-fc) + +(defface org-fc-type-cloze-hole-face + '((t (:bold t))) + "Face for org-fc cloze card holes." + :group 'org-fc) + +(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.") + +;;; 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 (1+ (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) + +;;; Footer + +(provide 'org-fc-type-cloze) + +;;; org-fc-type-cloze.el ends here diff --git a/org-fc-type-double.el b/org-fc-type-double.el new file mode 100644 index 0000000..12ecb8f --- /dev/null +++ b/org-fc-type-double.el @@ -0,0 +1,73 @@ +;;; org-fc-type-double.el --- Front <-> Back Card Type -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Leon Rische + +;; Author: Leon Rische <emacs@leonrische.me> +;; Url: https://www.leonrische.me/pages/org_flashcards.html +;; Package-requires: ((emacs "26.3") (org "9.3")) +;; Version: 0.0.1 + +;; 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: +;; +;; Variant of the normal card type that's also reviewed in the inverse +;; (back -> front) direction. +;; +;;; Code: + +(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) + +;;; Footer + +(provide 'org-fc-type-double) + +;;; org-fc-type-double.el ends here diff --git a/org-fc-type-normal.el b/org-fc-type-normal.el new file mode 100644 index 0000000..9dddf14 --- /dev/null +++ b/org-fc-type-normal.el @@ -0,0 +1,65 @@ +;;; org-fc-type-normal.el --- Front -> Back Card Type -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Leon Rische + +;; Author: Leon Rische <emacs@leonrische.me> +;; Url: https://www.leonrische.me/pages/org_flashcards.html +;; Package-requires: ((emacs "26.3") (org "9.3")) +;; Version: 0.0.1 + +;; 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: +;; +;;; Code: + +(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) + +;;; Footer + +(provide 'org-fc-type-normal) + +;;; org-fc-type-normal.el ends here diff --git a/org-fc-type-text-input.el b/org-fc-type-text-input.el new file mode 100644 index 0000000..6d8430c --- /dev/null +++ b/org-fc-type-text-input.el @@ -0,0 +1,109 @@ +;;; org-fc-type-text-input.el --- Text-input card type -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Leon Rische + +;; Author: Leon Rische <emacs@leonrische.me> +;; Url: https://www.leonrische.me/pages/org_flashcards.html +;; Package-requires: ((emacs "26.3") (org "9.3")) +;; Version: 0.0.1 + +;; 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: +;; +;;; Code: + +(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) + +;;; Footer + +(provide 'org-fc-type-text-input) + +;;; org-fc-type-text-input.el ends here diff --git a/org-fc-type-vocab.el b/org-fc-type-vocab.el new file mode 100644 index 0000000..f278049 --- /dev/null +++ b/org-fc-type-vocab.el @@ -0,0 +1,126 @@ +;;; org-fc-type-vocab.el --- Card type for learning vocabulary -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Leon Rische + +;; Author: Leon Rische <emacs@leonrische.me> +;; Url: https://www.leonrische.me/pages/org_flashcards.html +;; Package-requires: ((emacs "26.3") (org "9.3")) +;; Version: 0.0.1 + +;; 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 of this type should have the (foreign language) word as their +;; heading with a definition on the back. +;; +;; During review, the user is prompted for the definition of the word +;; or asked to type in the word based on its definitions. +;; +;;; Code: + +(require 'org-fc-audio) + +(defcustom org-fc-type-vocab-slow-speed 0.7 + "Speed to use for slow playback." + :type 'number + :group 'org-fc) + +(defcustom org-fc-type-vocab-audio-property "FC_VOCAB_AUDIO" + "Property with path to audio file." + :type 'string + :group 'org-fc) + +(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) + +;;; Footer + +(provide 'org-fc-type-vocab) + +;;; org-fc-type-vocab.el ends here @@ -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 |