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

(defconst gadict--pos '("n" "v" "adj" "adv" "pron" "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 '("ant" "syn" "rel" "topic" "hyper" "hypo")))
(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)
     (,(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 paragraph definition."
  (set (make-local-variable 'paragraph-separate)  "__$")
  (set (make-local-variable 'paragraph-start)  "__$") )

(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))

(defvar er/try-expand-list)
(defun gadict-setup-expansions ()
  "Add `gadict-mode' specific expansions."
  (set (make-local-variable 'er/try-expand-list) (list #'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."
  (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  []")
    (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)))
        (unless (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-setup-keymap ()
  "Setup gadict keymap."
  (define-key (current-local-map) [M-return] 'gadict-search)
  (define-key (current-local-map) [S-return] 'gadict-insert-translation)
  (define-key (current-local-map) [C-return] 'gadict-insert-template-in-order))

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

(provide 'gadict)

;;; dict-mode.el ends here

(provide 'gadict)

;;; gadict.el ends here