Added new adjectives.
;;; gadict.el --- major mode for editing gadict dictionary source files -*- lexical-binding: t -*-
;; Copyright (C) 2016 by Oleksandr Gavenko <gavenkoa@gmail.com>
;; You can do anything with this file without any warranty.
;; Author: Oleksandr Gavenko <gavenkoa@gmail.com>
;; Maintainer: Oleksandr Gavenko <gavenkoa@gmail.com>
;; Created: 2016
;; Version: 0.1
;; Keywords: dict, dictionary
;;; Commentary:
;;
;; Mode can be installed by:
;;
;; (autoload 'gadict-mode "gadict")
;;
;; File association can be registered by:
;;
;; (add-to-list 'auto-mode-alist (cons "\\.gadict$" 'gadict-mode))
;;; Code:
(defun gadict--trim-left (s)
"Remove whitespace at the beginning of S."
(if (string-match "\\`[ \t\n\r]+" s)
(replace-match "" t t s)
s))
(defun gadict--trim-right (s)
"Remove whitespace at the end of S."
(if (string-match "[ \t\n\r]+\\'" s)
(replace-match "" t t s)
s))
(defun gadict--trim (s)
"Remove whitespace at the beginning and end of S."
(gadict--trim-left (gadict--trim-right s)))
(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]+")
(defun gadict--vowel-group-count (s)
(let ( (cnt 0) (start 0) )
(while (string-match gadict--vowels-re s start)
(setq cnt (1+ cnt))
(setq start (match-end 0)))
cnt))
(defun gadict--espeak-cleanup-accent (s)
"Remove accent if only one syllable in word."
(if (<= (gadict--vowel-group-count s) 1)
(replace-regexp-in-string "[$,1$h$l(B]" "" s)
s))
(defun gadict--espeak-cleanup-accent-in-sentence (s)
"Remove accent if only one syllable in word."
(mapconcat #'gadict--espeak-cleanup-accent (split-string s " ") " "))
(defun gadict--espeak-cleanup (s)
"Cleanup espeak IPA output."
(mapc (lambda (fn) (setq s (funcall fn s)))
(list
;; UTF symbol between t$(O*h(B to make ligature.
(lambda (str) (replace-regexp-in-string "[\x200D]" "" str))
(lambda (str) (replace-regexp-in-string "t$(O*h(B" "$,1$G(B" str))
(lambda (str) (replace-regexp-in-string "$,1k{(B" ",0!(B" str))
#'gadict--trim
#'gadict--espeak-cleanup-accent-in-sentence))
s)
(defvar gadict-espeak-enabled nil
"Is espeak used.")
(defvar gadict-espeak-program "espeak")
(defvar gadict-espeak-program-ipa-args "-q --ipa=2")
;; "en" "en-gb" "en-us" "en-sc"
(defvar gadict-espeak-voices-list '("en-gb" "en-us")
"What voices to show. Look to 'espeak --voices' for full list.")
(defvar gadict-espeak-default-voice "en-us"
"Default voice for espeak. Used in article template.")
(defun gadict-espeak-ipa (str &optional voice)
(gadict--espeak-cleanup
(shell-command-to-string
(format "%s %s %s %s"
gadict-espeak-program
gadict-espeak-program-ipa-args
(if (stringp voice) (concat "-v" (shell-quote-argument voice)) "")
(shell-quote-argument str)))))
(defun gadict-espeak-headline-line (headword)
(mapconcat (lambda (voice) (format "%s: %s"
(propertize voice 'face '(:foreground "red"))
(gadict-espeak-ipa headword voice)))
(if (listp gadict-espeak-voices-list) gadict-espeak-voices-list '(nil))
" | "))
;; (defun gadict-espeak-headline-display ()
;; (interactive)
;; (message (gadict-espeak-headline-line)))
(defvar gadict-espeak-headline-headword nil)
(defun gadict-espeak-headline-display ()
(when (eq major-mode 'gadict-mode)
(let ( (headword (condition-case nil (gadict-nearest-headword) (error nil))) )
(unless (eq headword gadict-espeak-headline-headword)
(setq gadict-espeak-headline-headword headword)
(setq header-line-format (if headword (gadict-espeak-headline-line headword) nil))
(force-mode-line-update)))))
(defvar gadict-espeak-headline-timer nil)
(defun gadict-espeak-headline-enable ()
"Enable headline with espeak IPA pronunciation."
(interactive)
(unless gadict-espeak-headline-timer
(setq gadict-espeak-headline-timer (run-with-idle-timer 1 t #'gadict-espeak-headline-display))))
(defun gadict-espeak-headline-disable ()
"Enable headline with espeak IPA pronunciation."
(interactive)
(when gadict-espeak-headline-timer
(cancel-timer gadict-espeak-headline-timer))
(setq gadict-espeak-headline-timer nil)
(setq header-line-format nil))
(defconst gadict--pos '("n" "v" "adj" "adv" "pron" "det" "prep" "num" "conj" "int" "phr" "phr.v" "contr" "abbr" "prefix")
"Defined parts of speech.")
(defconst gadict--art-lang-regex (regexp-opt '("en" "ru" "uk" "la")))
(defconst gadict--art-rel-regex (regexp-opt '("cnt" "ant" "syn" "rel" "topic" "hyper" "hypo" "col")))
(defconst gadict--art-var-regex (regexp-opt '("rare" "v1" "v2" "v3" "s" "pl" "male" "female" "abbr" "comp" "super" "Am" "Br" "Au")))
(defconst gadict--art-pos-regex (regexp-opt gadict--pos))
(defgroup gadict nil
"gadict-mode customization."
:group 'wp)
(defface gadict-tr-face '((t :foreground "#40a040" :slant italic))
"Face for marker of translation."
:group 'gadict)
(defface gadict-ex-face '((t :foreground "#20a0c0" :slant italic))
"Face for marker of example."
:group 'gadict)
(defface gadict-glos-face '((t :foreground "#a04040" :slant italic))
"Face for marker of explanation."
:group 'gadict)
(defvar gadict-font-lock-keywords
`( ("^\\(__\\)\n\n\\(\\w.*\\)$" (1 font-lock-function-name-face) (2 font-lock-keyword-face))
("^ .*\n\\(\\w.*\\)" (1 font-lock-keyword-face))
("^#.*" . font-lock-comment-face)
("^ +\\[[^]\n:]+]" . font-lock-type-face)
("^ +homo: " . 'gadict-tr-face)
(,(format "^%s: " gadict--art-lang-regex) . 'gadict-tr-face)
(,(format "^%s> " gadict--art-lang-regex) . 'gadict-ex-face)
(,(format "^%s= " gadict--art-lang-regex) . 'gadict-glos-face)
(,(format "^%s: " gadict--art-rel-regex) . font-lock-doc-face)
(,(format "^ +%s$" gadict--art-var-regex) . font-lock-doc-face)
(,(format "^%s$" gadict--art-pos-regex) . font-lock-warning-face) ))
(defun gadict-setup-fontlock ()
"Setup gadict fontlock."
(setq font-lock-defaults
'(gadict-font-lock-keywords
t nil nil nil
(font-lock-multiline . t) ))
(add-hook 'font-lock-extend-region-functions 'gadict-font-lock-extend-region t) )
(defun gadict-setup-syntax ()
"Setup gadict characters syntax."
(modify-syntax-entry ?' "w"))
(defun gadict-setup-comment ()
"Setup gadict comment commands."
(set (make-local-variable 'comment-start) "#")
(set (make-local-variable 'comment-continue) nil)
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-end-skip) nil)
(set (make-local-variable 'comment-multi-line) nil)
(set (make-local-variable 'comment-use-syntax) nil) )
(defun gadict-setup-paragraph ()
"Setup gadict sentence/paragraph definition."
(set (make-local-variable 'paragraph-separate) "__$")
(set (make-local-variable 'paragraph-start) "__$")
(set (make-local-variable 'sentence-end) "\n"))
(defun gadict-setup-page ()
"Setup gadict page definition."
(set (make-local-variable 'page-delimiter) "__$") )
(defvar gadict-indent-offset 2
"Indent level.")
(defun gadict-indent-line ()
"Indent line in gdict mode."
(if (eq (current-indentation) gadict-indent-offset)
(indent-line-to 0)
(indent-line-to gadict-indent-offset)))
(defun gadict-setup-indent ()
"Setup indenting for gdict mode."
(set (make-local-variable 'indent-line-function) 'gadict-indent-line))
(defun gadict-mark-article ()
"Mark current article."
(end-of-line)
(re-search-backward "^__$")
(set-mark (point))
(forward-line)
(if (re-search-forward "^__$" nil t)
(forward-line 0)
(goto-char (point-max)))
(exchange-point-and-mark))
(defun gadict-mark-line ()
"Mark current line."
(forward-line 0)
(set-mark (point))
(forward-line 1)
(exchange-point-and-mark))
(defvar er/try-expand-list)
(defun gadict-setup-expansions ()
"Add `gadict-mode' specific expansions."
(set (make-local-variable 'er/try-expand-list) (list #'er/mark-word #'gadict-mark-line #'gadict-mark-article)))
(defvar font-lock-beg)
(defvar font-lock-end)
(defun gadict-font-lock-extend-region ()
"Look for '__' expression and extend `font-lock-beg' and `font-lock-end'."
;; (message "%d:%d, %d lines" font-lock-beg font-lock-end (count-lines font-lock-beg font-lock-end))
(cond
((and
(< (count-lines font-lock-beg font-lock-end) 5)
(not (and (<= (point-max) font-lock-end) (<= font-lock-beg (point-min)) )))
(save-excursion
(goto-char font-lock-beg)
(forward-line -2)
(setq font-lock-beg (point))
(goto-char font-lock-end)
(forward-line 3)
(setq font-lock-end (point)))
t)
(t nil) ))
(defvar-local gadict-tr nil
"Translation markers as string separated by comma. Define own
values in .dir-local.el or as -*- gadict-tr: \"...\" -*- file prelude")
(put 'gadict-tr 'safe-local-variable 'string-or-null-p)
(defun gadict-insert-template (&optional headword)
"Insert new article template after the current place.
If `gadict-espeak-enabled' is `t' pronunciation will be filled
with espeak `gadict-espeak-default-voice'."
(interactive)
(if (re-search-forward "^__" nil t)
(beginning-of-line)
(goto-char (point-max)))
(while (eq (char-before) ?\n)
(delete-char -1))
(insert-char ?\n)
(insert-char ?_ 2)
(insert-char ?\n 3)
(when (stringp gadict-tr)
(mapc (lambda (tr)
(insert-char ?\n)
(insert tr)
(insert ": "))
(split-string gadict-tr ","))
(insert-char ?\n)
(backward-char)
(re-search-backward "^$"))
(backward-char)
(when headword
(insert headword)
(insert "\n [")
(if gadict-espeak-enabled
(progn
(insert (gadict-espeak-ipa headword gadict-espeak-default-voice))
(insert "]")
(when gadict-tr
(search-forward ": ")))
(insert "]")
(backward-char))))
(defun gadict-search-floor (headword)
"Move to HEADWORD definition or place on posiiton for new corresponding
definition. Check for headwords ordering during search.
Return `t' if definition found, `nil' if no such headword."
(let ( prev curr )
(catch 'exit
(goto-char (point-min))
(unless (re-search-forward "^__$" nil t)
(throw 'exit nil))
(forward-line 2)
(setq prev (buffer-substring-no-properties (point) (line-end-position)))
(when (string= headword prev)
(throw 'exit t))
(when (string< headword prev)
(goto-char (point-min))
(throw 'exit nil))
(while t
(unless (re-search-forward "^__$" nil t)
(throw 'exit nil))
(forward-line 2)
(setq curr (buffer-substring-no-properties (point) (line-end-position)))
(when (string> prev curr)
(error (format "%s < %s" curr prev)))
(when (string= headword curr)
(throw 'exit t))
(when (string< headword curr)
(forward-line -2)
(re-search-backward "^__$")
(forward-line 2)
(throw 'exit nil))
(setq prev curr)) )))
(defun gadict-search (headword)
"Move to HEADWORD definition or place on posiiton for new corresponding
definition. Check for headwords ordering during search."
(interactive (list (read-string "Headword: ")))
(gadict-search-floor headword)
(recenter))
(defun gadict-insert-template-in-order (headword)
"Insert new article template with respect of headword order."
(interactive (list (read-string "Headword: ")))
(unless (gadict-search-floor headword)
(gadict-insert-template headword))
(recenter))
(defun gadict--find-headword-end ()
(save-excursion
(end-of-line)
(re-search-backward "^__$")
(re-search-forward "^$")
(forward-char)
(re-search-forward "^$")
(point)))
(defun gadict-insert-translation (pos)
"Insert translation template with using value of `gadict-tr'."
(interactive (list (completing-read "POS: " gadict--pos nil t)))
(let ( (headword-end (gadict--find-headword-end)) )
(if (< (point) headword-end)
(goto-char headword-end)
(re-search-forward "^\\(?:\\|__\\)$")
(when (eq (char-before) ?_)
(beginning-of-line)
;; (newline)
;; (backward-char)
))
(insert-char ?\n)
(insert pos)
(insert-char ?\n)
(save-excursion
(mapc (lambda (lang)
(insert lang)
(insert ": \n"))
(split-string gadict-tr ",")))
(end-of-line) ))
(defun gadict-nearest-headword ()
"Return nearest headword looking upward."
(save-excursion
(let ( (orig (point)) limit )
(re-search-backward "^__$")
(forward-line 1)
(unless (and (eq (char-before) ?\n) (eq (char-after) ?\n))
(error "Syntax error: there is not empty line after '__'..."))
(forward-line 1)
(when (< orig (point))
(setq orig (point)))
(setq limit (point))
(re-search-forward "^$")
(when (< orig (point))
(goto-char orig)
(end-of-line))
(re-search-backward "^\\([^ ].*\\)$" limit)
(match-string 1)
)))
(defun gadict-copy-pronunciation (&optional headword)
"Copy existing pronunciation of selected region or current word to `kill-ring'."
(interactive
(list (if (use-region-p)
(buffer-substring (region-beginning) (region-end))
(thing-at-point 'word))))
(save-excursion
(gadict-search-floor headword)
(when (search-forward-regexp "\\[\\([^]]+\\)]")
(kill-new (match-string 1)))))
(defun gadict-copy-espeak-pronunciation (&optional headword)
"Copy espeak pronunciation of selected region or current word to `kill-ring'."
(interactive
(list (if (use-region-p)
(buffer-substring (region-beginning) (region-end))
(thing-at-point 'word))))
(kill-new (gadict-espeak-headline-line headword)))
(defun gadict-setup-keymap ()
"Setup gadict keymap."
(define-key (current-local-map) [S-return] 'gadict-insert-translation)
(define-key (current-local-map) [C-return] 'gadict-insert-template-in-order)
(define-key (current-local-map) [C-S-return] 'gadict-search)
(define-key (current-local-map) [M-return] 'gadict-copy-pronunciation)
(define-key (current-local-map) [M-S-return] 'gadict-copy-espeak-pronunciation))
;;;###autoload
(define-derived-mode gadict-mode fundamental-mode "gadict"
"Derived mode for editing gadict dictionary source files."
(gadict-setup-fontlock)
(gadict-setup-keymap)
(gadict-setup-syntax)
(gadict-setup-paragraph)
(gadict-setup-page)
(gadict-setup-comment)
(gadict-setup-indent)
(gadict-setup-expansions)
(when (executable-find gadict-espeak-program)
(setq gadict-espeak-enabled t)
(gadict-espeak-headline-enable)))
(provide 'gadict)
;;; dict-mode.el ends here
(provide 'gadict)
;;; gadict.el ends here