-
Notifications
You must be signed in to change notification settings - Fork 0
/
foreign.el
236 lines (211 loc) · 8.09 KB
/
foreign.el
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
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
;;; package --- Summary
;;; Commentary:
;;; Application to learn new vocabulary in foreign language.
;;; functions/foreign.el -*- lexical-binding: t; -*-
;;; Require: Emacs version >= 29.3
;;; Code:
(require 'cc-defs)
(require 'dash)
(require 'foreign-mode)
(require 'org)
(require 'rect)
(defgroup foreign nil
"Options for foreign."
:group 'foreign)
(defvar foreign--answers nil)
(defvar foreign--position nil)
(defconst foreign--check-box "[ ]")
(defconst foreign--check-box-checked "[X]")
(defconst foreign-entity-tag "foreign")
(defun foreign--string-contains? (str1 str2 &optional ignore-case)
"Search STR2 in STR1."
(with-temp-buffer
(insert str1)
(goto-char (point-min))
(let ((case-fold-search ignore-case))
(ignore-error 'search-failed
(search-forward str2)
t))))
(defun foreign--current-line ()
"Return current line."
(let ((start)
(end))
(beginning-of-line)
(setq start (point))
(end-of-line)
(setq end (point))
(buffer-substring-no-properties start end)))
(defun foreign--current-line-is-heading? ()
"Does the current line is heading?"
(save-excursion
(let ((line (foreign--current-line)))
(string-match-p (concat "^*+.+" foreign-entity-tag) line))))
(defun foreign--normalize-line (str)
"Remove extra symbols of the beginning of the line.
STR - string which will be normalized"
(let ((remove-from-string
(lambda (rgx target)
(replace-regexp-in-string rgx "" target))))
(->> str
(funcall remove-from-string "^\s?+[-+*]\s+"))))
(defun foreign--copy-all-content ()
"Select all content under the current heading at point.
Select only org-list-items"
(save-excursion
(let ((content nil)
(line))
(forward-line)
(while (ignore-errors
(setq line (foreign--current-line))
(setq content (cons (foreign--normalize-line line) content))
(org-next-item)))
(string-join content "\n"))))
(defun foreign--content-to-touples (content swap?)
"CONTENT of org entity.
SWAP - boolean value signs of swapping target word with its translation."
(->> (split-string content "\n")
(-map (lambda (row) (-map 'string-trim (split-string row "-"))))
(-map (lambda (pair)
(if swap?
(list (cadr pair) (car pair))
pair)))))
(defun foreign--shuffle (coll)
"Shuffle COLL."
(let ((acc)
(rest (vconcat coll))
(roll))
(dotimes (_ (length rest))
(setq roll (random (length rest)))
(setq acc (cons (elt rest roll) acc))
(setq rest (vconcat (seq-take rest roll) (seq-drop rest (1+ roll)))))
acc))
(defun foreign--start-learning (header swap?)
"Create learning session by current HEADER."
(let ((current-point (point))
(content (foreign--copy-all-content))
(prepared-content)
(time (format-time-string "%Y-%m-%d %H-%M" (current-time))))
(setq foreign--position (list :place current-point :buffer-name (buffer-name)))
(setq foreign--answers (foreign--content-to-touples content swap?))
(switch-to-buffer (concat "foreign-learning *" header "* *" time "*"))
(->> foreign--answers
(-map 'car)
(-map (lambda (row) (concat foreign--check-box " " row " - \n")))
(foreign--shuffle)
(string-join)
(insert))
(goto-char (point-min))
(end-of-line)
(foreign-mode)))
(defun foreign--find-answer-by-key (key)
"Look for an answer by KEY and return it."
(->> foreign--answers
(-find (lambda (coll)
(cl-destructuring-bind (key_ answer) coll
(string= key key_))))
(-last 'identity)))
(defun foreign--answer-is-wrong (answer)
"Check answer on correct by ANSWER."
(cl-destructuring-bind (key-checked answer) (split-string answer "-")
(let ((key (string-trim (substring key-checked (length foreign--check-box))))
(right-answer))
(setq right-answer (foreign--find-answer-by-key key))
(if right-answer
(if (and answer
(not (string-empty-p (string-trim answer)))
(foreign--string-contains? (string-trim right-answer) (string-trim answer) t))
nil
right-answer)
(message (concat "Couldn't find " key))))))
(defun foreign--check-line (max-line)
"Check current line of correction.
MAX-LINE need to indent RIGHT-ANSWER"
(let* ((curr-line (foreign--current-line))
(curr-line-size (length curr-line))
(right-answer (foreign--answer-is-wrong curr-line))
(padding (spaces-string (+ 2 max-line (* -1 curr-line-size)))))
(if (not right-answer)
(progn
(beginning-of-line)
(kill-region (point) (+ (point) (length foreign--check-box)))
(insert foreign--check-box-checked)
t)
(progn
(end-of-line)
(insert (concat padding "(" (string-trim right-answer) ")"))))))
(defun foreign-put-tag ()
"Put sign that means it is a foreign entity."
(interactive)
(org-set-tags foreign-entity-tag))
(defun foreign--put-last-statistics (all right wrong)
"Store ALL, RIGHT and WRONG result."
(when (and foreign--position (string= "y" (read-string "Would you like to leave session?y/n ")))
(save-excursion
(switch-to-buffer (plist-get foreign--position :buffer-name))
(goto-char (plist-get foreign--position :place))
(let* ((start (progn
(beginning-of-line)
(point)))
(end (progn
(re-search-forward foreign-entity-tag)
(- (point) (length foreign-entity-tag) 2)))
(line (buffer-substring-no-properties start end))
(new-line))
(when (string-match-p "^*+\s+\\w+.+$" line) ;;is org heading like * Org
(setq new-line (replace-regexp-in-string "\s+\\[[0-9]+/.[0-9]+/.[0-9]+]" "" line))
(kill-region start end)
(beginning-of-line)
(insert (concat
new-line
" ["
(number-to-string all)
"/+"
(number-to-string right)
"/-"
(number-to-string wrong)
"]")))))))
(defun foreign--max-line-size ()
"Return max line size in the buffer."
(let ((max-size 0)
(next-size))
(goto-char (point-min))
(while (not (eobp))
(setq next-size (length (foreign--current-line)))
(when (> next-size max-size) (setq max-size next-size))
(forward-line))
max-size))
(defun foreign-check-answers ()
"Finish learning session.
Prints result and toggle checkbox of answers."
(interactive)
(when (and (eq major-mode #'foreign-mode) (not (foreign--string-contains? (buffer-string) "Statistic")))
(let ((right-count 0)
(all-count 0)
(max-line (foreign--max-line-size)))
(save-excursion
(goto-char (point-min))
(while (foreign--string-contains? (foreign--current-line) foreign--check-box)
(setq all-count (+ all-count 1))
(setq right-count (+ right-count (if (foreign--check-line max-line) 1 0)))
(forward-line))
(end-of-line)
(insert (if (= all-count right-count)
"\nYou are absolutely right!!!"
(concat "\nStatistic right:"
(number-to-string right-count)
" wrong:"
(number-to-string (- all-count right-count))))))
(foreign--put-last-statistics all-count right-count (- all-count right-count)))))
(defun foreign-start-learning (&optional swap)
"Start learning session.
Copy all heading content. Expected content rows of `'word - translation`'.
When you wrote all translations you can call `'foreign-check-answers`'
to get a result of training.
SWAP - boolean value signs of swapping target word with its translation."
(interactive)
(setq swap (string= "y" (read-string "Swap?(y/n)")))
(if (foreign--current-line-is-heading?)
(foreign--start-learning (org-get-heading) swap)
(message "You should stay on header which you would like to learn")))
(provide 'foreign)
;;; foreign.el