|
1 ;;; gadict.el --- major mode for editing gadict dictionary source files -*- lexical-binding: t -*- |
|
2 |
|
3 ;; Copyright (C) 2016 by Oleksandr Gavenko <gavenkoa@gmail.com> |
|
4 |
|
5 ;; You can do anything with this file without any warranty. |
|
6 |
|
7 ;; Author: Oleksandr Gavenko <gavenkoa@gmail.com> |
|
8 ;; Maintainer: Oleksandr Gavenko <gavenkoa@gmail.com> |
|
9 ;; Created: 2016 |
|
10 ;; Version: 0.1 |
|
11 ;; Keywords: dict, dictionary |
|
12 |
|
13 ;;; Commentary: |
|
14 ;; |
|
15 ;; Mode can be installed by: |
|
16 ;; |
|
17 ;; (autoload 'gadict-mode "gadict") |
|
18 ;; |
|
19 ;; File association can be registered by: |
|
20 ;; |
|
21 ;; (add-to-list 'auto-mode-alist (cons "\\.gadict$" 'gadict-mode)) |
|
22 |
|
23 ;;; Code: |
|
24 |
|
25 (defun gadict--trim-left (s) |
|
26 "Remove whitespace at the beginning of S." |
|
27 (if (string-match "\\`[ \t\n\r]+" s) |
|
28 (replace-match "" t t s) |
|
29 s)) |
|
30 |
|
31 (defun gadict--trim-right (s) |
|
32 "Remove whitespace at the end of S." |
|
33 (if (string-match "[ \t\n\r]+\\'" s) |
|
34 (replace-match "" t t s) |
|
35 s)) |
|
36 |
|
37 (defun gadict--trim (s) |
|
38 "Remove whitespace at the beginning and end of S." |
|
39 (gadict--trim-left (gadict--trim-right s))) |
|
40 |
|
41 |
|
42 |
|
43 (defconst gadict--vowels-re "[o$(O+8+:+7+9(Ba$(O+3+0,Af(Be,0#$(O+1(Bi,0!(Bu$(O+5+C+U+S+T(B]+") |
|
44 |
|
45 (defun gadict--vowel-group-count (s) |
|
46 (let ( (cnt 0) (start 0) ) |
|
47 (while (string-match gadict--vowels-re s start) |
|
48 (setq cnt (1+ cnt)) |
|
49 (setq start (match-end 0))) |
|
50 cnt)) |
|
51 |
|
52 (defun gadict--espeak-cleanup-accent (s) |
|
53 "Remove accent if only one syllable in word." |
|
54 (if (<= (gadict--vowel-group-count s) 1) |
|
55 (replace-regexp-in-string "[$,1$h$l(B]" "" s) |
|
56 s)) |
|
57 |
|
58 (defun gadict--espeak-cleanup-accent-in-sentence (s) |
|
59 "Remove accent if only one syllable in word." |
|
60 (mapconcat #'gadict--espeak-cleanup-accent (split-string s " ") " ")) |
|
61 |
|
62 (defun gadict--espeak-cleanup (s) |
|
63 "Cleanup espeak IPA output." |
|
64 (mapc (lambda (fn) (setq s (funcall fn s))) |
|
65 (list |
|
66 ;; UTF symbol between t$(O*h(B to make ligature. |
|
67 (lambda (str) (replace-regexp-in-string "[\x200D]" "" str)) |
|
68 (lambda (str) (replace-regexp-in-string "t$(O*h(B" "$,1$G(B" str)) |
|
69 (lambda (str) (replace-regexp-in-string "$,1k{(B" ",0!(B" str)) |
|
70 #'gadict--trim |
|
71 #'gadict--espeak-cleanup-accent-in-sentence)) |
|
72 s) |
|
73 |
|
74 (defvar gadict-espeak-enabled nil |
|
75 "Is espeak used.") |
|
76 |
|
77 (defvar gadict-espeak-program "espeak") |
|
78 (defvar gadict-espeak-program-ipa-args "-q --ipa=2") |
|
79 ;; "en" "en-gb" "en-us" "en-sc" |
|
80 (defvar gadict-espeak-voices-list '("en-gb" "en-us") |
|
81 "What voices to show. Look to 'espeak --voices' for full list.") |
|
82 (defvar gadict-espeak-default-voice "en-us" |
|
83 "Default voice for espeak. Used in article template.") |
|
84 |
|
85 (defun gadict-espeak-ipa (str &optional voice) |
|
86 (gadict--espeak-cleanup |
|
87 (shell-command-to-string |
|
88 (format "%s %s %s %s" |
|
89 gadict-espeak-program |
|
90 gadict-espeak-program-ipa-args |
|
91 (if (stringp voice) (concat "-v" (shell-quote-argument voice)) "") |
|
92 (shell-quote-argument str))))) |
|
93 |
|
94 (defun gadict-espeak-headline-line (headword) |
|
95 (mapconcat (lambda (voice) (format "%s: %s" |
|
96 (propertize voice 'face '(:foreground "red")) |
|
97 (gadict-espeak-ipa headword voice))) |
|
98 (if (listp gadict-espeak-voices-list) gadict-espeak-voices-list '(nil)) |
|
99 " | ")) |
|
100 |
|
101 ;; (defun gadict-espeak-headline-display () |
|
102 ;; (interactive) |
|
103 ;; (message (gadict-espeak-headline-line))) |
|
104 |
|
105 (defvar gadict-espeak-headline-headword nil) |
|
106 |
|
107 (defun gadict-espeak-headline-display () |
|
108 (when (eq major-mode 'gadict-mode) |
|
109 (let ( (headword (condition-case nil (gadict-nearest-headword) (error nil))) ) |
|
110 (unless (eq headword gadict-espeak-headline-headword) |
|
111 (setq gadict-espeak-headline-headword headword) |
|
112 (setq header-line-format (if headword (gadict-espeak-headline-line headword) nil)) |
|
113 (force-mode-line-update))))) |
|
114 |
|
115 (defvar gadict-espeak-headline-timer nil) |
|
116 (defun gadict-espeak-headline-enable () |
|
117 "Enable headline with espeak IPA pronunciation." |
|
118 (interactive) |
|
119 (unless gadict-espeak-headline-timer |
|
120 (setq gadict-espeak-headline-timer (run-with-idle-timer 1 t #'gadict-espeak-headline-display)))) |
|
121 (defun gadict-espeak-headline-disable () |
|
122 "Enable headline with espeak IPA pronunciation." |
|
123 (interactive) |
|
124 (when gadict-espeak-headline-timer |
|
125 (cancel-timer gadict-espeak-headline-timer)) |
|
126 (setq gadict-espeak-headline-timer nil) |
|
127 (setq header-line-format nil)) |
|
128 |
|
129 |
|
130 |
|
131 (defconst gadict--pos '("n" "v" "adj" "adv" "pron" "det" "prep" "num" "conj" "int" "phr" "phr.v" "contr" "abbr" "prefix") |
|
132 "Defined parts of speech.") |
|
133 |
|
134 (defconst gadict--art-lang-regex (regexp-opt '("en" "ru" "uk" "la"))) |
|
135 (defconst gadict--art-rel-regex (regexp-opt '("cnt" "ant" "syn" "rel" "topic" "hyper" "hypo" "col"))) |
|
136 (defconst gadict--art-var-regex (regexp-opt '("rare" "v1" "v2" "v3" "s" "pl" "male" "female" "baby" "abbr" "comp" "super" "Am" "Br" "Au"))) |
|
137 (defconst gadict--art-pos-regex (regexp-opt gadict--pos)) |
|
138 |
|
139 (defgroup gadict nil |
|
140 "gadict-mode customization." |
|
141 :group 'wp) |
|
142 |
|
143 (defface gadict-tr-face '((t :foreground "#40a040" :slant italic)) |
|
144 "Face for marker of translation." |
|
145 :group 'gadict) |
|
146 (defface gadict-ex-face '((t :foreground "#20a0c0" :slant italic)) |
|
147 "Face for marker of example." |
|
148 :group 'gadict) |
|
149 (defface gadict-glos-face '((t :foreground "#a04040" :slant italic)) |
|
150 "Face for marker of explanation." |
|
151 :group 'gadict) |
|
152 |
|
153 (defvar gadict-font-lock-keywords |
|
154 `( ("^\\(__\\)\n\n\\(\\w.*\\)$" (1 font-lock-function-name-face) (2 font-lock-keyword-face)) |
|
155 ("^ .*\n\\(\\w.*\\)" (1 font-lock-keyword-face)) |
|
156 ("^#.*" . font-lock-comment-face) |
|
157 ("^ +\\[[^]\n:]+]" . font-lock-type-face) |
|
158 ("^ +homo: " . 'gadict-tr-face) |
|
159 (,(format "^%s: " gadict--art-lang-regex) . 'gadict-tr-face) |
|
160 (,(format "^%s> " gadict--art-lang-regex) . 'gadict-ex-face) |
|
161 (,(format "^%s= " gadict--art-lang-regex) . 'gadict-glos-face) |
|
162 (,(format "^%s: " gadict--art-rel-regex) . font-lock-doc-face) |
|
163 (,(format "^ +%s$" gadict--art-var-regex) . font-lock-doc-face) |
|
164 (,(format "^%s$" gadict--art-pos-regex) . font-lock-warning-face) )) |
|
165 |
|
166 (defun gadict-setup-fontlock () |
|
167 "Setup gadict fontlock." |
|
168 (setq font-lock-defaults |
|
169 '(gadict-font-lock-keywords |
|
170 t nil nil nil |
|
171 (font-lock-multiline . t) )) |
|
172 (add-hook 'font-lock-extend-region-functions 'gadict-font-lock-extend-region t) ) |
|
173 |
|
174 (defun gadict-setup-syntax () |
|
175 "Setup gadict characters syntax." |
|
176 (modify-syntax-entry ?' "w")) |
|
177 |
|
178 (defun gadict-setup-comment () |
|
179 "Setup gadict comment commands." |
|
180 (set (make-local-variable 'comment-start) "#") |
|
181 (set (make-local-variable 'comment-continue) nil) |
|
182 (set (make-local-variable 'comment-end) "") |
|
183 (set (make-local-variable 'comment-end-skip) nil) |
|
184 (set (make-local-variable 'comment-multi-line) nil) |
|
185 (set (make-local-variable 'comment-use-syntax) nil) ) |
|
186 |
|
187 (defun gadict-setup-paragraph () |
|
188 "Setup gadict sentence/paragraph definition." |
|
189 (set (make-local-variable 'paragraph-separate) "__$") |
|
190 (set (make-local-variable 'paragraph-start) "__$") |
|
191 (set (make-local-variable 'sentence-end) "\n")) |
|
192 |
|
193 (defun gadict-setup-page () |
|
194 "Setup gadict page definition." |
|
195 (set (make-local-variable 'page-delimiter) "__$") ) |
|
196 |
|
197 (defvar gadict-indent-offset 2 |
|
198 "Indent level.") |
|
199 |
|
200 (defun gadict-indent-line () |
|
201 "Indent line in gdict mode." |
|
202 (if (eq (current-indentation) gadict-indent-offset) |
|
203 (indent-line-to 0) |
|
204 (indent-line-to gadict-indent-offset))) |
|
205 |
|
206 (defun gadict-setup-indent () |
|
207 "Setup indenting for gdict mode." |
|
208 (set (make-local-variable 'indent-line-function) 'gadict-indent-line)) |
|
209 |
|
210 (defun gadict-mark-article () |
|
211 "Mark current article." |
|
212 (end-of-line) |
|
213 (re-search-backward "^__$") |
|
214 (set-mark (point)) |
|
215 (forward-line) |
|
216 (if (re-search-forward "^__$" nil t) |
|
217 (forward-line 0) |
|
218 (goto-char (point-max))) |
|
219 (exchange-point-and-mark)) |
|
220 |
|
221 (defun gadict-mark-line () |
|
222 "Mark current line." |
|
223 (forward-line 0) |
|
224 (set-mark (point)) |
|
225 (forward-line 1) |
|
226 (exchange-point-and-mark)) |
|
227 |
|
228 (defvar er/try-expand-list) |
|
229 (defun gadict-setup-expansions () |
|
230 "Add `gadict-mode' specific expansions." |
|
231 (set (make-local-variable 'er/try-expand-list) (list #'er/mark-word #'gadict-mark-line #'gadict-mark-article))) |
|
232 |
|
233 (defvar font-lock-beg) |
|
234 (defvar font-lock-end) |
|
235 (defun gadict-font-lock-extend-region () |
|
236 "Look for '__' expression and extend `font-lock-beg' and `font-lock-end'." |
|
237 ;; (message "%d:%d, %d lines" font-lock-beg font-lock-end (count-lines font-lock-beg font-lock-end)) |
|
238 (cond |
|
239 ((and |
|
240 (< (count-lines font-lock-beg font-lock-end) 5) |
|
241 (not (and (<= (point-max) font-lock-end) (<= font-lock-beg (point-min)) ))) |
|
242 (save-excursion |
|
243 (goto-char font-lock-beg) |
|
244 (forward-line -2) |
|
245 (setq font-lock-beg (point)) |
|
246 (goto-char font-lock-end) |
|
247 (forward-line 3) |
|
248 (setq font-lock-end (point))) |
|
249 t) |
|
250 (t nil) )) |
|
251 |
|
252 (defvar-local gadict-tr nil |
|
253 "Translation markers as string separated by comma. Define own |
|
254 values in .dir-local.el or as -*- gadict-tr: \"...\" -*- file prelude") |
|
255 (put 'gadict-tr 'safe-local-variable 'string-or-null-p) |
|
256 |
|
257 (defun gadict-insert-article (headword pos) |
|
258 "Insert new article after the current place. |
|
259 |
|
260 If `gadict-espeak-enabled' is `t' pronunciation will be filled |
|
261 with espeak `gadict-espeak-default-voice'." |
|
262 (if (re-search-forward "^__" nil t) |
|
263 (beginning-of-line) |
|
264 (goto-char (point-max))) |
|
265 (while (eq (char-before) ?\n) |
|
266 (delete-char -1)) |
|
267 (insert-char ?\n) |
|
268 (insert-char ?_ 2) |
|
269 (insert-char ?\n 3) |
|
270 (forward-char -1) |
|
271 (insert headword) |
|
272 (insert "\n [") |
|
273 (when gadict-espeak-enabled |
|
274 (insert (gadict-espeak-ipa headword gadict-espeak-default-voice))) |
|
275 (insert "]") |
|
276 (insert-char ?\n 2) |
|
277 (insert pos) |
|
278 (gadict--insert-tr)) |
|
279 |
|
280 (defun gadict-search-floor (headword) |
|
281 "Move to HEADWORD definition or place on posiiton for new corresponding |
|
282 definition. Check for headwords ordering during search. |
|
283 |
|
284 Return `t' if definition found, `nil' if no such headword." |
|
285 (let ( prev curr ) |
|
286 (catch 'exit |
|
287 (goto-char (point-min)) |
|
288 (unless (re-search-forward "^__$" nil t) |
|
289 (throw 'exit nil)) |
|
290 (forward-line 2) |
|
291 (setq prev (buffer-substring-no-properties (point) (line-end-position))) |
|
292 (when (string= headword prev) |
|
293 (throw 'exit t)) |
|
294 (when (string< headword prev) |
|
295 (goto-char (point-min)) |
|
296 (throw 'exit nil)) |
|
297 (while t |
|
298 (unless (re-search-forward "^__$" nil t) |
|
299 (throw 'exit nil)) |
|
300 (forward-line 2) |
|
301 (setq curr (buffer-substring-no-properties (point) (line-end-position))) |
|
302 (when (string> prev curr) |
|
303 (error (format "%s < %s" curr prev))) |
|
304 (when (string= headword curr) |
|
305 (throw 'exit t)) |
|
306 (when (string< headword curr) |
|
307 (forward-line -2) |
|
308 (re-search-backward "^__$") |
|
309 (forward-line 2) |
|
310 (throw 'exit nil)) |
|
311 (setq prev curr)) ))) |
|
312 |
|
313 (defun gadict-search (headword) |
|
314 "Move to HEADWORD definition or place on posiiton for new corresponding |
|
315 definition. Check for headwords ordering during search." |
|
316 (interactive (list (read-string "Headword: "))) |
|
317 (gadict-search-floor headword) |
|
318 (recenter)) |
|
319 |
|
320 (defun gadict-insert-article-in-order () |
|
321 "Insert new article template with respect of headword order." |
|
322 (interactive) |
|
323 (let (headword pos) |
|
324 (setq headword (read-string "Headword: ")) |
|
325 (unless (gadict-search-floor headword) |
|
326 (setq pos (completing-read "POS: " gadict--pos nil t)) |
|
327 (gadict-insert-article headword pos) |
|
328 (recenter)))) |
|
329 |
|
330 (defun gadict--find-headword-end () |
|
331 (save-excursion |
|
332 (end-of-line) |
|
333 (re-search-backward "^__$") |
|
334 (re-search-forward "^$") |
|
335 (forward-char) |
|
336 (re-search-forward "^$") |
|
337 (point))) |
|
338 |
|
339 (defun gadict-insert-translation (pos) |
|
340 "Insert translation template using value of `gadict-tr'." |
|
341 (interactive (list (completing-read "POS: " gadict--pos nil t))) |
|
342 (let ( (headword-end (gadict--find-headword-end)) ) |
|
343 (if (< (point) headword-end) |
|
344 (goto-char headword-end) |
|
345 (re-search-forward "^\\(?:\\|__\\)$") |
|
346 (when (eq (char-before) ?_) |
|
347 (beginning-of-line))) |
|
348 (insert-char ?\n 2) |
|
349 (forward-char -1) |
|
350 (insert pos) |
|
351 (gadict--insert-tr) )) |
|
352 |
|
353 (defun gadict--insert-tr () |
|
354 "Insert `gadict-tr' as multiline template on next line. Place point on the end of the first new line." |
|
355 (when (stringp gadict-tr) |
|
356 (save-excursion |
|
357 (end-of-line) |
|
358 (mapc (lambda (lang) |
|
359 (insert-char ?\n) |
|
360 (insert lang) |
|
361 (insert ": ")) |
|
362 (split-string gadict-tr ","))) |
|
363 (end-of-line 2))) |
|
364 |
|
365 (defun gadict-nearest-headword () |
|
366 "Return nearest headword looking upward." |
|
367 (save-excursion |
|
368 (let ( (orig (point)) limit ) |
|
369 (re-search-backward "^__$") |
|
370 (forward-line 1) |
|
371 (unless (and (eq (char-before) ?\n) (eq (char-after) ?\n)) |
|
372 (error "Syntax error: there is not empty line after '__'...")) |
|
373 (forward-line 1) |
|
374 (when (< orig (point)) |
|
375 (setq orig (point))) |
|
376 (setq limit (point)) |
|
377 (re-search-forward "^$") |
|
378 (when (< orig (point)) |
|
379 (goto-char orig) |
|
380 (end-of-line)) |
|
381 (re-search-backward "^\\([^ ].*\\)$" limit) |
|
382 (match-string 1) |
|
383 ))) |
|
384 |
|
385 (defun gadict-copy-pronunciation (&optional headword) |
|
386 "Copy existing pronunciation of selected region or current word to `kill-ring'." |
|
387 (interactive |
|
388 (list (if (use-region-p) |
|
389 (buffer-substring (region-beginning) (region-end)) |
|
390 (thing-at-point 'word)))) |
|
391 (save-excursion |
|
392 (gadict-search-floor headword) |
|
393 (when (search-forward-regexp "\\[\\([^]]+\\)]") |
|
394 (kill-new (match-string 1))))) |
|
395 |
|
396 (defun gadict-copy-espeak-pronunciation (&optional headword) |
|
397 "Copy espeak pronunciation of selected region or current word to `kill-ring'." |
|
398 (interactive |
|
399 (list (if (use-region-p) |
|
400 (buffer-substring (region-beginning) (region-end)) |
|
401 (thing-at-point 'word)))) |
|
402 (kill-new (gadict-espeak-headline-line headword))) |
|
403 |
|
404 (defun gadict-setup-keymap () |
|
405 "Setup gadict keymap." |
|
406 (define-key (current-local-map) [S-return] 'gadict-insert-translation) |
|
407 (define-key (current-local-map) [C-return] 'gadict-insert-article-in-order) |
|
408 (define-key (current-local-map) [C-S-return] 'gadict-search) |
|
409 (define-key (current-local-map) [M-return] 'gadict-copy-pronunciation) |
|
410 (define-key (current-local-map) [M-S-return] 'gadict-copy-espeak-pronunciation)) |
|
411 |
|
412 ;;;###autoload |
|
413 (define-derived-mode gadict-mode fundamental-mode "gadict" |
|
414 "Derived mode for editing gadict dictionary source files." |
|
415 (gadict-setup-fontlock) |
|
416 (gadict-setup-keymap) |
|
417 (gadict-setup-syntax) |
|
418 (gadict-setup-paragraph) |
|
419 (gadict-setup-page) |
|
420 (gadict-setup-comment) |
|
421 (gadict-setup-indent) |
|
422 (gadict-setup-expansions) |
|
423 (when (executable-find gadict-espeak-program) |
|
424 (setq gadict-espeak-enabled t) |
|
425 (gadict-espeak-headline-enable))) |
|
426 |
|
427 (provide 'gadict) |
|
428 |
|
429 ;;; gadict.el ends here |