;;; egg.el --- EGG Input Method Architecture       ;;; -*- coding: utf-8 -*-

;; Copyright (C) 1999, 2000 Free Software Foundation, Inc

;; Author: NIIBE Yutaka <gniibe@fsij.org>
;;         KATAYAMA Yoshio <kate@pfu.co.jp>

;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>

;; Keywords: input method

;; This file is part of EGG.

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

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

;;; Commentary:

;;; Code:

(require 'its)

(defconst egg-version "4.2.0"
  "Version number for this version of Tamago.")

(eval-when-compile
  (require 'cl))
(declare-function its-start (key context) "its.el" nil)
(declare-function its-exit-mode () "its.el" nil)
(declare-function egg-set-conversion-backend (backend-alist &optional force)
		  "egg-cnv.el" nil)
(declare-function egg-exit-conversion () "egg-cnv.el" nil)
(declare-function egg-finalize-backend ()
		  "egg-cnv.el" nil)

(defgroup egg nil
  "Tamago Version 4."
  :group 'leim
  :version "24.3")

(defcustom egg-mode-preference t
  "*Make Egg as modefull input method, if non-NIL."
  :group 'egg :type 'boolean)

(defvar egg-last-method-name nil)
(make-variable-buffer-local 'egg-last-method-name)
(put 'egg-last-method-name 'permanent-local t)

(defvar egg-mode-map-alist nil)
(defvar egg-sub-mode-map-alist nil)

(defmacro define-egg-mode-map (mode &rest initializer)
  (let ((map (intern (concat "egg-" (symbol-name mode) "-map")))
	(var (intern (concat "egg-" (symbol-name mode) "-mode")))
	(comment (concat (symbol-name mode) " keymap for EGG mode.")))
    `(progn
       (defvar ,map (let ((map (make-sparse-keymap)))
		      ,@initializer
		      map)
	 ,comment)
       (fset ',map ,map)
       (defvar ,var nil)
       (make-variable-buffer-local ',var)
       (put ',var 'permanent-local t)
       (or (assq ',var egg-mode-map-alist)
	   (setq egg-mode-map-alist (append egg-mode-map-alist
					    '((,var . ,map))))))))

(define-egg-mode-map modefull
  (let ((i 33))
    (while (< i 127)
      (define-key map (vector i) 'egg-self-insert-char)
      (setq i (1+ i)))))

(define-egg-mode-map modeless
  (define-key map " " 'mlh-space-bar-backward-henkan))

(defvar egg-enter/leave-fence-hook nil)

(defun egg-enter/leave-fence (&optional old new)
  (run-hooks 'egg-enter/leave-fence-hook))

(defvar egg-activated nil)
(make-variable-buffer-local 'egg-activated)
(put 'egg-activated 'permanent-local t)

(defun egg-activate-keymap ()
  (when (and egg-activated
	     (null (eq (car egg-sub-mode-map-alist)
		       (car minor-mode-overriding-map-alist))))
    (let ((alist (append egg-sub-mode-map-alist egg-mode-map-alist))
	  (overriding (copy-sequence minor-mode-overriding-map-alist)))
      (while alist
	(setq overriding (delq (assq (caar alist) overriding) overriding)
	      alist (cdr alist)))
      (setq minor-mode-overriding-map-alist (append egg-sub-mode-map-alist
						    overriding
						    egg-mode-map-alist)))))

(add-hook 'egg-enter/leave-fence-hook 'egg-activate-keymap t)

(defun egg-modify-fence (&rest arg)
  (add-hook 'post-command-hook 'egg-post-command-func))

(defun egg-post-command-func ()
  (run-hooks 'egg-enter/leave-fence-hook)
  (remove-hook 'post-command-hook 'egg-post-command-func))

(defvar egg-change-major-mode-buffer nil)

(defun egg-activate-keymap-after-command ()
  (while egg-change-major-mode-buffer
    (let ((buf (car egg-change-major-mode-buffer)))
      (if (buffer-live-p buf)
	  (with-current-buffer buf
	    (egg-activate-keymap)))
      (setq egg-change-major-mode-buffer (cdr egg-change-major-mode-buffer))))
  (remove-hook 'post-command-hook 'egg-activate-keymap-after-command))

(defun egg-change-major-mode-func ()
  (setq egg-change-major-mode-buffer (cons (current-buffer)
					   egg-change-major-mode-buffer))
  (add-hook 'post-command-hook 'egg-activate-keymap-after-command))

(add-hook 'change-major-mode-hook 'egg-change-major-mode-func)

;;;###autoload
(defun egg-mode (&rest arg)
  "Toggle EGG  mode.
\\[describe-bindings]
"
  (interactive "P")
  (if (null arg)
      ;; Turn off
      (unwind-protect
	  (progn
	    (its-exit-mode)
	    (egg-exit-conversion))
	(setq describe-current-input-method-function nil
	      egg-modefull-mode nil
	      egg-modeless-mode nil)
	(remove-hook 'input-method-activate-hook 'its-set-mode-line-title t)
	(force-mode-line-update))
    ;; Turn on
    (if (null (string= (car arg) egg-last-method-name))
	(progn
	  (funcall (nth 1 arg))))
    (egg-set-conversion-backend (nthcdr 2 arg))
    (setq egg-last-method-name (car arg)
	  egg-activated t)
    (egg-activate-keymap)
    (if egg-mode-preference
	(setq egg-modefull-mode t)
      (setq egg-modeless-mode t))
    (setq deactivate-current-input-method-function 'egg-mode)
    (setq describe-current-input-method-function 'egg-help)
    (add-hook 'input-method-activate-hook 'its-set-mode-line-title nil t)
    (if (eq (selected-window) (minibuffer-window))
	(add-hook 'minibuffer-exit-hook 'egg-exit-from-minibuffer))
    (run-hooks 'egg-mode-hook)))

(defun egg-exit-from-minibuffer ()
  (deactivate-input-method)
  (if (<= (minibuffer-depth) 1)
      (remove-hook 'minibuffer-exit-hook 'egg-exit-from-minibuffer)))

(defvar egg-context nil)

(defun egg-self-insert-char ()
  (interactive)
  (its-start last-command-event (and (eq last-command 'egg-use-context)
				     egg-context)))

(defun egg-remove-all-text-properties (from to &optional object)
  (let ((p from)
	props prop)
    (while (< p to)
      (setq prop (text-properties-at p object))
      (while prop
	(unless (eq (car prop) 'composition)
	  (setq props (plist-put props (car prop) nil)))
	(setq prop (cddr prop)))
      (setq p (next-property-change p object to)))
    (remove-text-properties from to props object)))

(defun egg-setup-invisibility-spec ()
  (if (listp buffer-invisibility-spec)
      (unless (condition-case nil (memq 'egg buffer-invisibility-spec) (error))
	(setq buffer-invisibility-spec (cons 'egg buffer-invisibility-spec)))
    (unless (eq buffer-invisibility-spec t)
      (setq buffer-invisibility-spec (list 'egg buffer-invisibility-spec)))))

(defun egg-set-face (beg end face &optional object)
  (put face 'face face)
  (add-text-properties beg end (list 'category face) object))

(defconst egg-messages
  '((nil
     (no-rcfile     "no egg-startup-file on %S")
     (rcfile-error  "error occured in egg-startup-file")
     (candidate     "candidates:")
     (register-str  "Chinese character:")
     (register-yomi "word registration ``%s''  pronunciation:")
     (registered    "dictionary entry ``%s''(%s: %s) is registerd at %s"))
    (Japanese
     (no-rcfile     "%S 上に egg-startup-file がありません")
     (rcfile-error  "egg-startup-file でエラーがありました")
     (candidate     "候補:")
     (register-str  "漢字:")
     (register-yomi "辞書登録『%s』  読み:")
     (registered    "辞書項目『%s』(%s: %s)を %s に登録しました")
     (sj3-register-1 "登録辞書名:")
     (sj3-register-2 "品詞名"))))

(defun egg-get-message (message)
  (or (nth 1 (assq message (cdr (assq 'Japanese egg-messages))))
      (nth 1 (assq message (cdr (assq nil egg-messages))))
      (error "EGG internal error: no such message: %s (%s)"
	     message 'Japanese)))

(put 'egg-error 'error-conditions '(error egg-error))
(put 'egg-error 'error-message "EGG error")

(defun egg-error (message &rest args)
  (if (symbolp message)
      (setq message (egg-get-message message)))
  (signal 'egg-error (list (apply 'format message args))))

;;;
;;; auto fill controll
;;;

(defun egg-do-auto-fill ()
  (if (and auto-fill-function (> (current-column) fill-column))
      (let ((ocolumn (current-column)))
	(funcall auto-fill-function)
	(while (and (< fill-column (current-column))
		    (< (current-column) ocolumn))
	  (setq ocolumn (current-column))
	  (funcall auto-fill-function)))))

(eval-when (eval load)
  (require 'menudiag)
  (require 'egg-mlh)
  (require 'egg-cnv))

(add-hook 'kill-emacs-hook 'egg-kill-emacs-function)
(defun egg-kill-emacs-function ()
  (egg-finalize-backend))

(provide 'egg)

;;; egg.el ends here
