summaryrefslogtreecommitdiff
path: root/org-fc-type-cloze.el
blob: 9f0cffdb8080bffa5e139534579f8d8a0c28113b (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
;;; org-fc-type-cloze.el --- Cloze deletion card type -*- lexical-binding: t; -*-

;; Copyright (C) 2020-2021  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.1.0

;; 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