;;; ellinika-dict-mode.el --- major mode for editing Ellinika dictionary files

;; Authors: 2004 Sergey Poznyakoff
;; Version:  1.0
;; Keywords: Ellinika, greek, dictionary
;; $Id$

;; This file is part of Ellinika.
;; Copyright (C) 2004 Sergey Poznyakoff.

;; Ellinika 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 2, or (at your option)
;; any later version.

;; Ellinika 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 Ellinika; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

(eval-when-compile
  ;; We use functions from these modules
  (mapcar 'require '(ellinika-mode)))

(defun ellinika-dict-guess-syntax ()
  (save-excursion
    (catch 'loop
      (while (search-backward-regexp "<\\(/?[^ >]+\\)\\(\\s +[^>]*\\)?>"
				     nil t)
	(let ((tag (buffer-substring
		    (match-beginning 1)
		    (match-end 1))))
	  (cond
	   ((or (string-equal tag "T") (string-equal tag "/T"))
	    (throw 'loop (ellinika-dict-guess-syntax)))
	   ((looking-at "</[MKXPF]>")
	    (throw 'loop 'node))
	   ((or (looking-at "</NODE>") (looking-at "<DICT>"))
	    (throw 'loop 'initial))
	   ((looking-at "<M>")
	    (throw 'loop 'alternative-input))
	   ((looking-at "<[KX]>")
	    (throw 'loop 'greek-input))
	   ((looking-at "<[PF]")
	    (throw 'loop 'greek-input))
	   ((looking-at "<[CE]>")) ;; continue
	   (t
	    (throw 'loop (intern tag))))))
      'initial)))
  
(defun ellinika-dict-select-input-method nil
  (let ((syntax (ellinika-dict-guess-syntax)))
    (cond
     ((eq syntax 'ascii-input)
      (inactivate-input-method))
     ((eq syntax 'alternative-input)
      (alt-input nil))
     ((eq syntax 'greek-input)
      (greek-input nil))
     ((or (eq syntax 'node) (eq syntax 'initial))
      (inactivate-input-method)))))

(defun ellinika-dict-newline (arg)
  (interactive "p")
  (ellinika-dict-select-input-method)
  (newline-and-indent))

(defun ellinika-dict-begin-node (arg)
  (interactive "p")
  (let ((syntax (ellinika-dict-guess-syntax)))
    (cond
     ((eq syntax 'initial)
      (beginning-of-line)
      (insert "<NODE>\n <K></K>\n</NODE>")
      (forward-line -1)
      (beginning-of-line)
      (forward-char 4)
      (greek-input nil))
     (t
      (message "Cannot start node here")))))

(defun ellinika-dict-init-block (tag &optional input-method)
  (beginning-of-line)
  (if (string-equal (ellinika-find-open-tag) "P")
      (insert " "))
  (insert " <" tag "></" tag ">")
  (backward-char (+ (length tag) 3))
  (when input-method
    (set-input-method input-method)))

(defun ellinika-dict-begin-article (arg)
  (interactive "p")
  (let ((syntax (ellinika-dict-guess-syntax)))
    (cond
     ((eq syntax 'node)
      (ellinika-dict-init-block "M" (if (boundp 'alternative-input-method)
				   alternative-input-method
				 nil)))
     (t
      (message "Cannot start key here")))))

(defun ellinika-dict-begin-key (arg)
  (interactive "p")
  (let ((syntax (ellinika-dict-guess-syntax)))
    (cond
     ((eq syntax 'node)
      (ellinika-dict-init-block "K" 'greek))
     (t
      (message "Cannot start key here")))))

(defun ellinika-dict-begin-pos (arg)
  (interactive "p")
  (let ((syntax (ellinika-dict-guess-syntax)))
    (cond
     ((eq syntax 'node)
      (ellinika-dict-init-block "P" 'greek))
     (t
      (message "Cannot start pos here")))))

(defun ellinika-dict-begin-forms (arg)
  (interactive "p")
  (let ((syntax (ellinika-dict-guess-syntax)))
    (cond
     ((eq syntax 'node)
      (ellinika-dict-init-block "F" 'greek))
     (t
      (message "Cannot start forms here")))))

(defun ellinika-dict-begin-xref (arg)
  (interactive "p")
  (let ((syntax (ellinika-dict-guess-syntax)))
    (cond
     ((eq syntax 'node)
      (ellinika-dict-init-block "X" 'greek))
     (t
      (message "Cannot start xref here")))))

(defun ellinika-dict-begin-ant (arg)
  (interactive "p")
  (let ((syntax (ellinika-dict-guess-syntax)))
    (cond
     ((eq syntax 'node)
      (ellinika-dict-init-block "A" 'greek))
     (t
      (message "Cannot start antonym here")))))

(defun ellinika-dict-begin-topic (arg)
  (interactive "p")
  (let ((syntax (ellinika-dict-guess-syntax)))
    (cond
     ((eq syntax 'initial)
      (insert "<T ID=\"\">\n</T>")
      (forward-line -1)
      (forward-char 7)
      (greek-input nil))
     ((eq syntax 'node)
      (insert "<T ID=\"\" />")
      (backward-char 4))
     (t
      (message "Cannot start topic here")))))

(defun ellinika-dict-begin-comment (arg)
  (interactive "p")
  (let ((tag (ellinika-find-open-tag)))
    (cond
     ((or (string-equal tag "M")
	  (string-equal tag "F"))
      (insert "<C></C>")
      (backward-char 4))
     (t
      (message "Cannot start comment here")))))

(defun ellinika-dict-begin-expl (arg)
  (interactive "p")
  (let ((tag (ellinika-find-open-tag)))
    (cond
     ((or (string-equal tag "M")
	  (string-equal tag "F"))
      (insert "<E></E>")
      (backward-char 4))
     (t
      (message "Cannot start explanation here")))))

;;;###autoload
(define-derived-mode ellinika-dict-mode ellinika-mode "Ellinika-Dict"
  "Major mode for editing Ellinika dictionary sources.

  Key bindings:
\\{ellinika-dict-mode-map}"

  (ellinika-set-close-tag-hook 'ellinika-dict-select-input-method)
  
  (define-key ellinika-dict-mode-map "\C-c\C-b" 'ellinika-dict-begin-node)
  (define-key ellinika-dict-mode-map "\C-c\C-m" 'ellinika-dict-begin-article)
  (define-key ellinika-dict-mode-map "\C-c\C-k" 'ellinika-dict-begin-key)
  (define-key ellinika-dict-mode-map "\C-c\C-p" 'ellinika-dict-begin-pos)
  (define-key ellinika-dict-mode-map "\C-c\C-f" 'ellinika-dict-begin-forms)
  (define-key ellinika-dict-mode-map "\C-c\C-x" 'ellinika-dict-begin-xref)
  (define-key ellinika-dict-mode-map "\C-c\C-a" 'ellinika-dict-begin-ant)
  (define-key ellinika-dict-mode-map "\C-c\C-t" 'ellinika-dict-begin-topic)
  (define-key ellinika-dict-mode-map "\C-c\C-c" 'ellinika-dict-begin-comment)
  (define-key ellinika-dict-mode-map "\C-c\C-e" 'ellinika-dict-begin-expl)
  (define-key ellinika-dict-mode-map "\C-m" 'ellinika-dict-newline))

(provide 'ellinika-dict-mode)

;;;; End of ellinika-dict-mode.el