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

(defun greek-input (arg)
  (interactive "p")
  (set-input-method 'greek))

(defun alt-input (arg)
  (interactive "p")
  (if (boundp 'alternative-input-method)
      (set-input-method alternative-input-method)
    (inactivate-input-method)))

(set-language-environment 'utf-8)


;;;

(defun ellinika-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-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-find-open-tag-internal ()
  (catch 'loop
    (let ((tag-list nil))
      (while (search-backward-regexp "<\\(/?[^ >]+\\)\\(\\s +[^>]*\\)?>"
				     nil t)
	(let ((tag (buffer-substring
		    (match-beginning 1)
		    (match-end 1))))
	  (cond
	   ((char-equal (string-to-char tag) ?\/)
	    (setq tag-list (cons (substring tag 1)
				 tag-list)))
	   ((looking-at "<!"))
	   ((looking-at "<[^ >]+\\(\\s +[^>]*\\)?/>"))
	   ((string-equal (car tag-list) tag)
	    (setq tag-list (cdr tag-list)))
	   (t
	    (throw 'loop tag))))))))

(defun ellinika-find-open-tag (&optional move-point)
  (if move-point
      (ellinika-find-open-tag-internal)
    (save-excursion
      (ellinika-find-open-tag-internal))))
	
(defun ellinika-select-input-method nil
  (let ((syntax (ellinika-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-newline (arg)
  (interactive "p")
  (ellinika-select-input-method)
  (newline-and-indent))

(defun ellinika-electric-obrace (arg)
  (interactive "p")
  (inactivate-input-method)
  (self-insert-command arg))

(defun ellinika-electric-cbrace (arg)
  (interactive "p")
  (inactivate-input-method)
  (self-insert-command arg)
  (ellinika-select-input-method))

(defun ellinika-close-tag (arg)
  (interactive "p")
  (let ((tag (ellinika-find-open-tag)))
    (cond
     (tag
      (insert (concat "</" tag ">"))
      (ellinika-select-input-method))
     (t
      (message "No open tags")))))

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

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

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

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

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

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

(defun ellinika-begin-topic (arg)
  (interactive "p")
  (let ((syntax (ellinika-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-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-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")))))

(defun ellinika-insert-include (arg)
  (interactive "p")
  (beginning-of-line)
  (insert "<INCLUDE FILE=\"\" />")
  (backward-char 4)
  (inactivate-input-method))

(defcustom alternative-input-method nil
  "Defines input-method for non-greek text in this buffer.")

(defcustom alternative-dictionary nil
  "Defines alternative (non-greek) spell-checking dictionary for this buffer.")

(defun ellinika-run-ispell (dict)
  (let ((ispell-skip-html t)
	(ispell-local-dictionary dict))
    (ispell)))

(defun ellinika-ispell-greek (arg)
  (interactive "p")
  (ellinika-run-ispell "greek"))

(defun ellinika-ispell-alt (arg)
  (interactive "p")
  (ellinika-run-ispell (if alternative-dictionary
			      alternative-dictionary
			 (error "Alternative dictionary not defined"))))
  
(defun ellinika-ispell (arg)
  (interactive "p")
  (ellinika-run-ispell  (if (> arg 0)
			    "greek"
			  (if alternative-dictionary
			      alternative-dictionary
			    (error "Alternative dictionary not defined")))))

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

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

  (make-variable-buffer-local 'alternative-input-method)
  (make-variable-buffer-local 'alternative-dictionary)
  
  (define-key ellinika-dict-mode-map "\C-c\C-b" 'ellinika-begin-node)
  (define-key ellinika-dict-mode-map "\C-c\C-m" 'ellinika-begin-article)
  (define-key ellinika-dict-mode-map "\C-c\C-k" 'ellinika-begin-key)
  (define-key ellinika-dict-mode-map "\C-c\C-p" 'ellinika-begin-pos)
  (define-key ellinika-dict-mode-map "\C-c\C-f" 'ellinika-begin-forms)
  (define-key ellinika-dict-mode-map "\C-c\C-x" 'ellinika-begin-xref)
  (define-key ellinika-dict-mode-map "\C-c\C-a" 'ellinika-begin-ant)
  (define-key ellinika-dict-mode-map "\C-c\C-t" 'ellinika-begin-topic)
  (define-key ellinika-dict-mode-map "\C-c\C-c" 'ellinika-begin-comment)
  (define-key ellinika-dict-mode-map "\C-c\C-e" 'ellinika-begin-expl)
  (define-key ellinika-dict-mode-map "\C-c\C-i" 'ellinika-insert-include)  
  (define-key ellinika-dict-mode-map "\C-c\C-g" 'ellinika-ispell-greek)
  (define-key ellinika-dict-mode-map "\C-c\C-s" 'ellinika-ispell-alt)

  (define-key ellinika-dict-mode-map "\M-g" 'greek-input)
  (define-key ellinika-dict-mode-map "\M-r" 'alt-input)
  (define-key ellinika-dict-mode-map "\C-c>" 'ellinika-close-tag)
  (define-key ellinika-dict-mode-map "<" 'ellinika-electric-obrace)
  (define-key ellinika-dict-mode-map ">" 'ellinika-electric-cbrace)
  (define-key ellinika-dict-mode-map "\C-m" 'ellinika-newline))

(provide 'ellinika-dict-mode)

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