;;; egg-remix.el --- Roman-Kana conversion input interface for Tamago4
;; Copyright (C) 2000-2003 Hiroki Hayashi

;; This program 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 of
;; the License, or (at your option) any later version.

;; This program 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 this program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA


;; Author: Hiroki Hayashi <payashi@dream.com>
;; Keywords: mule, egg, Japanese, input interface

;; Commentary:
;;   Egg ReMix えっぐ-りみっくす
;;   Tamago V4 で egg-mix.el と同様の入力環境を実現します。
;;   日本語の入力中に、モードを切り替えることなくアルファベット等が
;;   入力できるようになります。
;;   フェンス内の編集は、標準のたまごとは違い、入力したキーが単位になります。

;;   [入力例] 日本語と alphabet の混在
;;   ・標準の modefull mode の場合の入力(モードを2回切り替える必要がある)
;;     nihonngoto[SPC][RET][SPC]qalphabet[SPC][C-g]nokonnzai[SPC][RET]
;; 	                        ^             ^^^^^
;;   ・Egg ReMix の場合の入力(モードを切り替える操作がない)
;;     nihonngoto[SPC][RET][SPC]alphabet[SPC]nokonnzai[SPC][RET]

;;   ローマ字の綴りと英単語が同じ場合(例えば「まけ」と「make」)は、最後に
;;   ユーザが選択したものがフェンスに現れます。これが不都合な場合は
;;   C-r で強制的にアルファベットを、C-w でひらがなを選択します。この選択は
;;   ユーザ辞書に登録され、次回の入力時に参照されます。

;;   ロード
;;   内部で (require 'egg) をしているので、基本的には require や autoload や
;;   load を行っている部分で、egg の代りに egg-remix を指定すればよいです。
;;   ただし、egg-remix.el が load-path の通っているところに置いてあることが
;;   必要です。

;;   設定
;;   基本的にはコード中の個人設定用の変数群をコメントにしたがって設定します。
;;   実際の入力インターフェースは、egg-mode-preference の値で切り替わります。
;;   設定できる値は egg-input-mode-alist の各要素の car です。

;;     egg-mode-preference の値    インターフェース
;;       t または "egg"              たまご modefull モード
;;       nil または "mlh"            たまご modeless モード (mlh モード)
;;       "remix"                     Egg ReMix モード  

;; Change Log:
;;   Jun 15 2003: version 0.207
;;                ・t-gnus などの Message mode で正しく入力できない問題の
;;                  回避コードを追加
;;                ・Mew の添付領域で日本語入力モードになっていると、Mew の
;;                  コマンドを入力できない問題の回避コードを追加
;;   May 31 2003: version 0.206
;;                ・複数の Emacs からユーザ辞書に変更を加えてもいちいち確認
;;                  されないように修正
;;                ・フェンスの中に正規表現の演算子(*など)が入っていると、
;;                  変換モードをキャンセルしたときに正しい文字列を復元できない
;;                  bug を fix
;;   Jul 30 2002: version 0.205
;;                ・Wnn 以外の backend に対応するために、初期化動作時の
;;                  input-method を "japanese-egg-wnn" の決め打ちから
;;                  default-input-method を使うように変更
;;   Feb 11 2001: version 0.204
;;                ・font-lock-mode が有効なときに正しくフェンスを編集できない
;;                  問題を fix
;;                ・フェンスの face 表示に overlay を選択できるようにした
;;                  (変数 remix-use-overlay を追加)
;;                ・fence に使う文字列に remix-fence-* が残っていたのを修正
;;   Oct 30 2000: version 0.203
;;                ・isearch で日本語を入力中に C-g で中断すると、以後の
;;                  ミニバッファへの入力ができなくなる問題に対応
;;                  (C-g へ abort する関数をバインドして回避)
;;                ・変換モードから C-k でフェンスモードに戻ったときに、フェンスが
;;                  正しく作成されない問題を fix
;;   Oct 12 2000: version 0.202
;;                ・remix-fence-open, remix-fence-continue, remix-fence-close が
;;                  2文字以上のときに正常に動作しない問題に対応
;;                ・fence に使う文字列が remix-fence-* になっていたのを
;;                  its-fence-* に修正
;;                ・remix-sysdict や remix-usrdict が nil のときに正常に動作しない
;;                  問題点を fix
;;   Sep 27 2000: version 0.201
;;                ・細かな bug を fix
;;   Sep 27 2000: version 0.200
;;                ・とりあえず公開版

;; Code:

(require 'egg)

(defconst remix-version "0.207"
  "Egg ReMix のバージョン")
(defconst remix-version-date "Jun 15 2003"
  "Egg ReMix の最終更新日")

(activate-input-method default-input-method)
(activate-input-method nil)

;;;;====
;;;; 機能拡張のための Tamago4 native 関数のオーバーライド
;;;; 将来的には不必要になって欲しい:-)
;;;;====

;;;; its-restart 呼び出しを選択できるようにする
(defun egg-decide-before-point ()
  (interactive)
  (let* ((inhibit-read-only t)
	 (start (if (get-text-property (1- (point)) 'egg-start)
		    (point)
		  (previous-single-property-change (point) 'egg-start)))
	 (end (if (get-text-property (point) 'egg-end)
		  (point)
		(next-single-property-change (point) 'egg-end)))
	 (decided (buffer-substring start (point)))
	 (undecided (buffer-substring (point) end))
	 i len bunsetsu source context)
    (delete-region
     (previous-single-property-change start 'egg-start nil (point-min))
     (next-single-property-change end 'egg-end nil (point-max)))
    (setq i 0
	  len (length decided))
    (while (< i len)
      (setq bunsetsu (nconc bunsetsu (list (egg-get-bunsetsu-info i decided)))
	    i (egg-next-bunsetsu-point i 1 decided len))
      (if (or (= i len)
	      (egg-get-bunsetsu-last (1- i) decided))
	  (progn
	    (insert (mapconcat 'egg-get-bunsetsu-converted bunsetsu nil))
	    (setq context (cons (cons (egg-bunsetsu-get-backend (car bunsetsu))
				      (egg-end-conversion bunsetsu nil))
				context)
		  bunsetsu nil))))
    (setq len (length undecided))
    (if (= len 0)
	(progn
	  (egg-do-auto-fill)
	  (run-hooks 'input-method-after-insert-chunk-hook)
	  context)
      (setq i 0)
      (while (< i len)
	(setq bunsetsu (egg-get-bunsetsu-info i undecided)
	      source (cons (egg-get-bunsetsu-source bunsetsu)
			   source))
	(put-text-property 0 (length (car source))
			   'egg-lang
			   (egg-get-source-language bunsetsu)
			   (car source))
	(setq i (egg-next-bunsetsu-point i 1 undecided len)))
      (funcall (nth 3 (assoc egg-mode-preference egg-input-mode-alist))
	       (apply 'concat (nreverse source)) t t context))))

;;; its-restart 呼び出しを選択できるようにする
(defun egg-abort-conversion ()
  (interactive)
  (let ((inhibit-read-only t)
	source context)
    (goto-char (previous-single-property-change
		(if (get-text-property (1- (point)) 'egg-start)
		    (point)
		  (previous-single-property-change (point) 'egg-start))
		'egg-start nil (point-min)))
    (setq source (get-text-property (point) 'egg-source)
	  context (get-text-property (point) 'egg-context))
    (delete-region (point) (next-single-property-change
			    (next-single-property-change (point) 'egg-end)
			    'egg-end nil (point-max)))
    (funcall (nth 3 (assoc egg-mode-preference egg-input-mode-alist))
	     source nil nil context)))

;;; egg-mode-preference を拡張し、各種のモードを追加できるようにする
;;;###autoload
(defun egg-mode (&rest arg)
  "Toggle EGG mode.
\\[describe-bindings]
"
  (interactive "P")
  (if (null arg)
      ;; Turn off
      (unwind-protect
	  (progn
	    (funcall (nth 4 (assoc egg-mode-preference egg-input-mode-alist)))
	    (egg-exit-conversion))
	(setq describe-current-input-method-function nil)
	(let ((modelist egg-input-mode-alist)
	      mode)
	  (while (setq mode (car modelist))
	    (set (modename mode) nil)
	    (setq modelist (cdr modelist))))
	(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))
	  (setq egg-default-language its-current-language)))
    (egg-set-conversion-backend (nthcdr 2 arg))
    (egg-set-conversion-backend
     (list (assq its-current-language (nthcdr 2 arg))) t)
    (setq egg-last-method-name (car arg)
	  egg-activated t)
    (egg-activate-keymap)

    (let ((mode (assoc egg-mode-preference egg-input-mode-alist)))
      (set (modename mode) t)
      (if (nth 3 mode)
	  (its-define-select-keys (symbol-value (mapname mode)))))

    (setq inactivate-current-input-method-function 'egg-mode)
    (setq describe-current-input-method-function 'egg-help)
    (make-local-hook 'input-method-activate-hook)
    (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)))

;;; 最後に input-method-after-insert-chunk-hook を呼び出すようにする
(defun egg-decide-first-char ()
  (interactive)
  (let* ((inhibit-read-only t)
	 (start (if (get-text-property (1- (point)) 'egg-start)
		    (point)
		  (previous-single-property-change (point) 'egg-start)))
	 (end (if (get-text-property (point) 'egg-end)
		  (point)
		(next-single-property-change (point) 'egg-end)))
	 (bunsetsu (egg-get-bunsetsu-info start)))
    (delete-region
     (previous-single-property-change start 'egg-start nil (point-min))
     (next-single-property-change end 'egg-end nil (point-max)))
    (egg-end-conversion (list bunsetsu) nil)
    (insert (egg-string-to-char-at (egg-get-bunsetsu-converted bunsetsu) 0))
    (run-hooks 'input-method-after-insert-chunk-hook)))

;;;;====
;;;; 機能拡張用の追加コード
;;;;====
(defsubst modename (mode)
  (intern (format "egg-%s-mode" (nth 1 mode))))
(defsubst mapname (mode)
  (intern (format "egg-%s-map" (nth 1 mode))))

(defvar egg-input-mode-alist '(("egg"   "modefull" t   its-restart   its-exit-mode)
			       ("mlh"   "modeless" nil its-restart   its-exit-mode)
			       ("remix" "remix"    t   remix-restart remix-exit-mode)
			       (t       "modefull" t   its-restart   its-exit-mode)
			       (nil     "modeless" nil its-restart   its-exit-mode))
  "Egg の入力モードのリスト。
各要素は\"モード名\", \"内部識別名\", modefullフラグ, 変換モードからの復帰関数, フェンスモードの終了関数のリストである。
\"モード名\"を egg-mode-preference に設定することで、入力モードを切り替える")


;;;;====
;;;; Egg-ReMix code
;;;;====
;;;###autoload
(defun remix-version ()
  "Egg ReMix のバージョンを返す"
  (interactive)
  (message "Egg ReMix version %s (%s)" remix-version remix-version-date))

;;;;====
;;;; 個人設定用の変数
;;;;====
(defvar remix-quiet nil
  "*メッセージを表示するときに ding を行うかどうかのフラグ。
non-nil だと ding を行わない")

(defvar remix-remix-fence t
  "*フェンスの表示形式を Egg-ReMix で設定したものに初期化するかどうかのフラグ。
non-nil ならば、初期化し、nil ならなにもしない")

(defvar remix-fence-invisible t
  "*フェンスの両端を表示しないかどうかのフラグ。
non-nil ならば、フェンスの両端は表示しない")

(defvar remix-fence-open "|"
  "*フェンスの開始に使う文字。
remix-remix-fence が t の時は、1文字以上の文字列を指定する必要がある")

(defvar remix-fence-continue "+"
  "*継続するフェンスの開始に使う文字。
remix-remix-fence が t の時は、1文字以上の文字列を指定する必要がある")

(defvar remix-fence-close "|"
  "*フェンスの終端時使う文字。
remix-remix-fence が t の時は、1文字以上の文字列を指定する必要がある")

(defvar remix-fence-face 'underline
  "*フェンスの表示に使う face")

(defvar remix-sysdict '("/usr/dict/words")
  "*システムで使う英単語辞書の絶対パスのリスト。
このリストが nil ならばシステムの辞書は使わない。
辞書は1行1単語の形式である必要がある")

(defvar remix-usrdict (expand-file-name "~/.remix-freq")
  "*ユーザ用の単語辞書のファイル名。
最後にローマ字綴りとみなしたか非ローマ字綴りとみなしたかも記録する。
nil ならばユーザ用単語辞書を使わない")

(defvar remix-auto-add-entry t
  "*ユーザ辞書にない綴りを自動的に追加するかどうかのフラグ。
値が non-nil なら、ユーザ辞書にない綴りがシステム辞書にあったときに
自動的にユーザ辞書に追加する")

(defvar remix-use-overlay 10
  "*フェンスの face を overlay で表示するかどうかのフラグ。
nil ならば text property を使う。
数値ならばその値を priority とする overlay を使う。")

;;;;====
;;;; Egg-ReMix の内部で使う変数
;;;;====
(defvar remix-sysdictbuf " *remix-sysdict*"
  "システム辞書を格納するバッファの名前")

(defvar remix-usrdictbuf " *remix-usrdict*"
  "ユーザ辞書を格納するバッファの名前")

(defvar remix-state-indicator-alist '((remix-kanaseq .      "あ") ; ローマ字綴り
				      (remix-uncertain .    "◇") ; 状態未確定
				      (remix-nokanaseq .    "◆") ; 非ローマ字綴り
				      (remix-indictkana .   "☆") ; 辞書内のローマ字綴り
				      (remix-indictnokana . "★") ; 辞書内の非ローマ字綴り
				      (remix-inedit .       "▽") ; フェンス編集中
				      )
  "*ReMixの状態とモードライン行のインジケータの対応リスト")

;;; 初期状態(フォールバック)のインジケータ
(or (assq 'remix-default remix-state-indicator-alist)
    (setq remix-state-indicator-alist (append remix-state-indicator-alist
					      (list
					       (cons 'remix-default
						     (its-get-indicator
						      (symbol-value its-current-map)))))))

(define-egg-mode-map remix
  (define-key map "\C-^" 'egg-simple-input-method)
  (let ((i 33))
    (while (< i 127)
      (define-key map (vector i) 'remix-self-insert-char)
      (setq i (1+ i)))))

(defvar remix-its-mode-map
  (let ((map (make-sparse-keymap))
	(i 33))
    (define-key map "\C-a" 'remix-beginning-of-input-buffer)
    (define-key map "\C-b" 'remix-backward)
    (define-key map "\C-c" 'remix-cancel-input)
    (define-key map "\C-d" 'remix-delete)
    (define-key map "\C-e" 'remix-end-of-input-buffer)
    (define-key map "\C-f" 'remix-forward)
    (define-key map "\C-g" 'remix-abort)
    (define-key map "\C-]" 'remix-cancel-input)
    (define-key map "\C-h" 'remix-mode-help-command)
    (define-key map "\C-k" 'remix-kill-line)
    (define-key map "\C-m" 'remix-exit-mode)
    (define-key map [return] 'remix-exit-mode)
    (define-key map "\C-r" 'remix-select-nokana)
    (define-key map "\C-t" 'remix-transpose-chars)
    (define-key map "\C-w" 'remix-select-kana)
    (define-key map [backspace] 'remix-delete-backward)
    (define-key map [delete] 'remix-delete-backward)
    (define-key map [right] 'remix-forward)
    (define-key map [left] 'remix-backward)
    (while (< i 127)
      (define-key map (vector i) 'remix-its-self-insert-char)
      (setq i (1+ i)))
    (define-key map " "    'remix-kick-convert-region-or-self-insert)
    (define-key map "\177" 'remix-delete-backward)
    ;;
    (define-key map "\M-h" 'remix-hiragana)
    (define-key map "\M-k" 'remix-katakana)
    (define-key map "\M->" 'remix-full-width)
    map)
  "Keymap for EggReMix's fence")
(defvar remix-its-fence-mode nil)
(fset 'remix-its-mode-map remix-its-mode-map)

(make-variable-buffer-local 'remix-its-fence-mode)
(put 'remix-its-fence-mode 'permanent-local t)
(or (assq 'remix-its-fence-mode egg-sub-mode-map-alist)
    (setq egg-sub-mode-map-alist (cons '(remix-its-fence-mode . remix-its-mode-map)
				       egg-sub-mode-map-alist)))

(defvar remix-context nil)
(defvar remix-fence-operation nil)
(defvar remix-usrdict-modified nil)

;;; remix-remix-fence が non-nil なら、フェンスの外観を
;;; remix のもので初期化する
(if remix-remix-fence
    (setq its-fence-invisible remix-fence-invisible
	  its-fence-open      remix-fence-open
	  its-fence-continue  remix-fence-continue
	  its-fence-close     remix-fence-close
	  its-fence-face      remix-fence-face
	  egg-conversion-fence-invisible remix-fence-invisible
	  egg-conversion-fence-open      remix-fence-open
	  egg-conversion-fence-continue  remix-fence-continue
	  egg-conversion-fence-close     remix-fence-close
	  egg-conversion-face            remix-fence-face))

;;; remix-use-overlay の妥当性チェック
;;; nil: overlay を使わない
;;; number: overlay の priority にする
(or
 (null remix-use-overlay)
 (numberp remix-use-overlay)
 (setq remix-use-overlay nil))

;;; 関数定義
(defun remix-enter/leave-fence (&optional old new)
  (setq remix-its-fence-mode (remix-in-fence-p))
  (or remix-fence-operation
      (let* ((status (get-text-property (point) 'remix-status))
	     (title (cdr (or (assq status remix-state-indicator-alist)
			     (assq 'remix-default remix-state-indicator-alist)))))
	(following-char)
	(if (equal title current-input-method-title)
	    nil
	  (setq current-input-method-title title)
	  (force-mode-line-update)))))

(defun remix-in-fence-p ()
  (and (eq (get-text-property (point) 'intangible) 'remix-part-2)
       (get-text-property (point) 'read-only)))

(defun remix-beginning-of-input-buffer ()
  (interactive)
  (let* ((inhibit-read-only t)
	 (p (point))
	 (seq-before (get-text-property p 'remix-keyseq-before))
	 (seq-after (get-text-property p 'remix-keyseq-after)))
    (setq seq-after (concat seq-before seq-after))
    (setq seq-before nil)
    (add-text-properties p (1+ p) (list 'remix-keyseq-before seq-before
					'remix-keyseq-after seq-after))

    (remix-update-fence 'remix-inedit)))

(defun remix-end-of-input-buffer (&optional last)
  (interactive)
  (let* ((inhibit-read-only t)
	 (p (point))
	 (seq-before (get-text-property p 'remix-keyseq-before))
	 (seq-after (get-text-property p 'remix-keyseq-after)))
    (setq seq-before (concat seq-before seq-after))
    (setq seq-after nil)
    (add-text-properties p (1+ p) (list 'remix-keyseq-before seq-before
					'remix-keyseq-after seq-after
					'remix-status 'remix-uncertain))

    (remix-input last)))

(defun remix-forward (&optional n)
  (interactive)
  (setq n (or n 1))
  (if (> n 0)
      (let* ((inhibit-read-only t)
	     (p (point))
	     (seq-before (get-text-property p 'remix-keyseq-before))
	     (seq-after (get-text-property p 'remix-keyseq-after))
	     new-before new-after)
	(if seq-after
	    (progn
	      (setq n (min n (length seq-after)))
	      (setq new-before (concat seq-before (substring seq-after 0 n)))
	      (setq new-after (substring seq-after n))
	      (if (zerop (length new-after))
		  (setq new-after nil))
	      (add-text-properties p (1+ p) (list 'remix-keyseq-before new-before
						  'remix-keyseq-after new-after))

	      (if new-after
		  (remix-update-fence 'remix-inedit)
		(remix-input)))
	  (message "ReMix: end of fence")
	  (or remix-quiet (ding))))))

(defun remix-backward (&optional n)
  (interactive)
  (setq n (or n 1))
  (if (> n 0)
      (let* ((inhibit-read-only t)
	     (p (point))
	     (seq-before (get-text-property p 'remix-keyseq-before))
	     (seq-after (get-text-property p 'remix-keyseq-after))
	     new-before new-after)
	(if seq-before
	    (progn
	      (setq n (- (min n (length seq-before))))
	      (setq new-before (substring seq-before 0 n))
	      (if (zerop (length new-before))
		  (setq new-before nil))
	      (setq new-after (concat (substring seq-before n) seq-after))
	      (add-text-properties p (1+ p) (list 'remix-keyseq-before new-before
						  'remix-keyseq-after new-after))

	      (remix-update-fence 'remix-inedit))
	  (message "ReMix: beginnig of fence")
	  (or remix-quiet (ding))))))

(defun remix-cancel-input ()
  "Cancel all of input"
  (interactive)
  (if (remix-in-fence-p)
      (let ((inhibit-read-only t)
	    (p (point)))
	(add-text-properties p (1+ p) (list 'remix-keyseq-before nil
					    'remix-keyseq-after nil))
	(remix-update-fence 'remix-default))))

(defun remix-delete (&optional n)
  (interactive)
  (setq n (or n 1))
  (if (> n 0)
      (let* ((inhibit-read-only t)
	     (p (point))
	     (seq-after (get-text-property p 'remix-keyseq-after)))
	(if seq-after
	    (progn
	      (setq n (min n (length seq-after))
		    seq-after (substring seq-after n))
	      (if (zerop (length seq-after))
		  (setq seq-after nil))
	      (add-text-properties p (1+ p) (list 'remix-keyseq-after seq-after))
	      (if seq-after
		  (remix-update-fence 'remix-inedit)
		(add-text-properties p (1+ p) '(remix-status remix-uncertain))
		(remix-input)))
	  (message "ReMix: end of fence")
	  (or remix-quiet (ding))))))

(defun remix-delete-backward (&optional n)
  (interactive)
  (setq n (or n 1))
  (if (> n 0)
      (let* ((inhibit-read-only t)
	     (p (point))
	     (seq-before (get-text-property p 'remix-keyseq-before))
	     (seq-after (get-text-property p 'remix-keyseq-after)))
	(if seq-before
	    (progn
	      (setq n (- (min n (length seq-before)))
		    seq-before (substring seq-before 0 n))
	      (if (zerop (length seq-before))
		  (setq seq-before nil))
	      (add-text-properties p (1+ p) (list 'remix-keyseq-before seq-before))
	      (if seq-after
		  (remix-update-fence 'remix-inedit)
		(add-text-properties p (1+ p) '(remix-status remix-uncertain))
		(remix-input)))
	  (message "ReMix: beginning of fence")
	  (or remix-quiet (ding))))))

(defun remix-kill-line ()
  (interactive)
  (let ((inhibit-read-only t))
    (add-text-properties (point) (1+ (point)) '(remix-keyseq-after nil))
    (remix-input)))

(defun remix-transpose-chars ()
  (interactive)
  (let* ((inhibit-read-only t)
	 (p (point))
	 (seq-before (get-text-property p 'remix-keyseq-before))
	 (seq-after (get-text-property p 'remix-keyseq-after))
	 new-before new-after)
    (cond
     ((null seq-before)			; フェンスの先頭のとき
      (message "ReMix: beginning of fence")
      (or remix-quiet (ding)))
     ((= (length (concat seq-before seq-after)) 1) ; フェンスに1文字しかないとき
      (message "ReMix: there is no char to transpose")
      (or remix-quiet (ding)))
     ((null seq-after)			; フェンスの末尾のとき
      (setq new-before (concat (substring seq-before 0 -2)
			       (substring seq-before -1)
			       (substring seq-before -2 -1)))
      (add-text-properties p (1+ p) (list 'remix-keyseq-before new-before
					  'remix-status 'remix-uncertain))
      (remix-input))
     (t
      (setq new-before (concat (substring seq-before 0 -1)
			       (substring seq-after 0 1)
			       (substring seq-before -1))
	    new-after (substring seq-after 1))
      (if (zerop (length new-after))
	  (setq new-after nil))
      (add-text-properties p (1+ p) (list 'remix-keyseq-before new-before
					  'remix-keyseq-after new-after))
      (remix-update-fence 'remix-inedit)))))

(defun remix-select-kana ()
  "現在のフェンス全体を仮名であるとユーザ辞書に登録する。
ただし、辞書にない場合は無視する"
  (interactive)
  (remix-end-of-input-buffer)
  (let* ((p (point))
	 (seq (get-text-property p 'remix-keyseq-before))
	 dict)
    (when (and seq
	       (setq dict (remix-seq-indict-p seq)))
      (remix-set-usrdict seq "1" dict)
      (remix-input))))

(defun remix-select-nokana ()
  "現在のフェンス全体を仮名ではないものとして確定する。
フェンスがローマ字綴りとして正しければユーザ辞書に登録する。"
  (interactive)
  (remix-end-of-input-buffer)
  (let* ((p (point))
	 (seq (get-text-property p 'remix-keyseq-before))
	 (status (get-text-property p 'remix-status))
	 dict)
    (if (and seq
	     (or (eq status 'remix-kanaseq)
		 (eq status 'remix-uncertain)
		 (eq status 'remix-indictkana)))
	(let ((inhibit-read-only t)
	      (remix-fence-operation t))
	  (delete-region (remix-search-beginning-seq) (remix-search-end-seq))
	  (insert seq)
	  (remix-put-cursor)
	  (remix-set-usrdict seq "0" (remix-seq-indict-p seq))))
    (remix-exit-mode-internal)))

(defun remix-hiragana ()
  (interactive)
  (remix-end-of-input-buffer)
  (let* ((inhibit-read-only t)
	 (p1 (remix-search-beginning-seq))
	 (p2 (remix-search-end-seq))
	 (str (buffer-substring p1 (1- p2))))
    (delete-region p1 p2)
    (remove-text-properties 0 (length str) (text-properties-at 0 str) str)
    (remix-exit-mode-internal (japanese-hiragana str))))

(defun remix-katakana ()
  (interactive)
  (remix-end-of-input-buffer)
  (let* ((inhibit-read-only t)
	 (p1 (remix-search-beginning-seq))
	 (p2 (remix-search-end-seq))
	 (str (buffer-substring p1 (1- p2))))
    (delete-region p1 p2)
    (remove-text-properties 0 (length str) (text-properties-at 0 str) str)
    (remix-exit-mode-internal (japanese-katakana str))))

(defun remix-full-width ()
  (interactive)
  (remix-end-of-input-buffer)
  (let* ((inhibit-read-only t)
	 (str (get-text-property (point) 'remix-keyseq-before))
	 (full "")
	 (len (length str))
	 (i 0)
	 lang)
    (delete-region (remix-search-beginning-seq) (remix-search-end-seq))
    (egg-separate-languages str)
    (setq lang (get-text-property 0 'egg-lang str))
    (while (< i len)
      (setq full (concat full (char-to-string
			       (symbol-value (intern-soft (format "%s%c" lang (aref str i))
							  its-half-full-table)))))
      (setq i (1+ i)))

    (remix-exit-mode-internal full)))

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

(defun remix-its-self-insert-char ()
  (interactive)
  (remix-input last-command-char))

(defun remix-start (key context)
  (let ((remix-context context))
    (remix-initialize)
    (remix-setup-fence-mode)
    (remix-input key)))

(defun remix-restart (str set-prop begnning context)
  (let* ((remix-context context)
	 p cursor
	 (prop (text-properties-at (point)))
	 (seq (plist-get prop 'remix-keyseq-before))
	 (kana (remix-translate-keyseq seq t)))
    (setq seq (remix-chop-head-keyseq seq (string-match (concat (regexp-quote str) "\\'")
							kana)))
    (if (zerop (length seq))
	(setq seq nil))
    (setq prop (plist-put prop 'remix-keyseq-before seq))
    (remix-delete-cursor)
    (remix-setup-fence-mode)
    (setq p (point))
    (add-text-properties p (1+ p) prop)
    (remix-update-fence 'remix-uncertain)))

(defun remix-exit-mode ()
  "Exit ReMix input"
  (interactive)
  (remix-exit-mode-internal))

(defun remix-abort ()
  "Cancel current input and signal a quit"
  (interactive)
  (remix-cancel-input)
  (signal 'quit nil))

(defun remix-exit-mode-internal (&optional key)
  (if (remix-in-fence-p)
      (let ((inhibit-read-only t)
	    (remix-fence-operation t)
	    (status (get-text-property (point) 'remix-status))
	    (overlay (get-text-property (point) 'remix-overlay)))
	(if overlay
	    (delete-overlay overlay))
	(remix-delete-cursor)
	(remix-delete-fence)
	(if key
	    (insert key)))))

(defun remix-input (&optional key)
  (let* ((inhibit-read-only t)
	 (p (point))
	 (seq-before (get-text-property p 'remix-keyseq-before))
	 (last nil)
	 status
	 dict)
    (if key
	(when (numberp key)
	  (setq seq-before (concat seq-before (vector key)))
	  (add-text-properties p (1+ p) (list 'remix-keyseq-before seq-before))))
    (when seq-before
      (setq dict (remix-seq-indict-p seq-before)) ; 辞書にある綴りか調べる
      (cond
       ((null dict)			; 辞書にはない綴り
	(setq status 'remix-uncertain))
       ((zerop dict)	; システム辞書にある単語(ユーザ辞書に登録せず)
	(setq status 'remix-indictnokana))
       (t
	(let ((flag (save-excursion
		      (set-buffer remix-usrdictbuf)
		      (char-after dict))))
	  (if (= flag ?0)
	      (setq status 'remix-indictnokana)	; 辞書内にある非ローマ字綴り
	    (setq status 'remix-indictkana)))))) ; 辞書内にあるローマ字綴り
    (remix-update-fence status (and key (symbolp key)))))

(defun remix-update-fence (status &optional last)
  (let* ((inhibit-read-only t)
	 (remix-fence-operation t)
	 (p (point))
	 (p1 (remix-search-beginning-seq))
	 (p2 (remix-search-end-seq))
	 (previous-status (get-text-property p 'remix-status))
	 (seq-before (get-text-property p 'remix-keyseq-before))
	 (seq-after (get-text-property p 'remix-keyseq-after))
	 (tr (if (or (eq previous-status 'remix-nokanaseq)
		     (eq status 'remix-indictnokana))
		 seq-before
	       (remix-translate-keyseq seq-before last)))
	 (cursor (buffer-substring p (1+ p)))
	 (overlay (get-text-property 0 'remix-overlay cursor)))

    ;; font-lock-mode が active だといちいち point が変化するので
    ;; フェンスの更新が終わるまで無効にする
    ;;;; なぜか combine-after-change-calls が Emacs-21.0.97 では機能しないので
    ;;;; let でごまかし
    ;; (combine-after-change-calls
    (let ((after-change-functions nil))
      ;; フェンス内をいったんクリアする
      (delete-region p1 p2)

      ;; キーシークェンスが空なら、フェンスを消去してインジケータを更新する
      (if (zerop (length (concat seq-before seq-after)))
	  (remix-delete-fence)
	;; カーソルの手前部分を挿入する
	(when tr
	  (insert tr)
	  (add-text-properties p1 (point) (list 'intangible 'remix-part-1
						'read-only t
						'face its-fence-face)))
	(setq p (point))
	;; カーソルを挿入する
	(insert cursor)
	(setq p2 (point))
	;; カーソルの後ろがあれば挿入する
	(when seq-after
	  (insert seq-after)
	  (add-text-properties p2 (point) (list 'intangible 'remix-part-2
						'read-only t
						'face its-fence-face))
	  (setq p2 (point)))

	;; overlay の再設定
	(if remix-use-overlay
	    (move-overlay overlay p1 p2))

	;; 状態を更新する
	(goto-char p)
	(if (eq status 'remix-uncertain)
	    (cond
	     ((null its-translation-result)
	      (setq status 'remix-nokanaseq))
	     ((equal its-translation-result tr)
	      (setq status 'remix-kanaseq))))
	(if (eq previous-status 'remix-inedit)
	    (setq status 'remix-inedit))
	(add-text-properties p (1+ p) (list 'remix-status status)))
      (setq current-input-method-title
	    (cdr (or (assq status remix-state-indicator-alist)
		     (assq 'remix-default remix-state-indicator-alist))))
      (force-mode-line-update))))

(defun remix-setup-fence-mode ()
  (let ((open-props '(remix-start t intangible remix-part-1 front-sticky nil))
	(close-props '(remix-end t intangible remix-part-2 rear-nonsticky t))
	(p0 (point))
	p1)
    (if (or (null (stringp its-fence-open)) (zerop (length its-fence-open))
	    (null (stringp its-fence-continue)) (zerop (length its-fence-continue))
	    (null (stringp its-fence-close)) (zerop (length its-fence-close)))
	(error "invalid fence"))
    ;; Put open-fence before inhibit-read-only to detect read-only
    (insert (if remix-context its-fence-continue its-fence-open))
    (let ((inhibit-read-only t)
	  (p1 (point))
	  overlay)
      (add-text-properties p0 p1 open-props)
      (insert its-fence-close)
      (add-text-properties p1 (point) close-props)
      (if its-fence-invisible
	  (put-text-property p0 (point) 'invisible t))
      (put-text-property p0 (point) 'read-only t)
      (its-define-select-keys remix-its-mode-map)
      (goto-char p1)
      (remix-put-cursor)
      (when remix-use-overlay
	(setq overlay (make-overlay p1 (1+ p1)))
	(overlay-put overlay 'face its-fence-face)
	(overlay-put overlay 'evaporate t)
	(overlay-put overlay 'priority remix-use-overlay)
	(add-text-properties p1 (1+ p1) (list 'remix-overlay overlay)))
      (if remix-context
	  (add-text-properties p1 (1+ p1) (list 'remix-context remix-context))))))

(defun remix-put-cursor ()
  (let ((p (point))
	(str (copy-sequence "!")))
    (set-text-properties 0 1 (list
			      'remix-cursor        t
			      'read-only           t
			      'invisible           t
			      'intangible          'remix-part-2
			      'point-entered       'egg-enter/leave-fence
			      'point-left          'egg-enter/leave-fence
			      'modification-hooks  '(egg-modify-fence)
			      'remix-keyseq-before nil
			      'remix-keyseq-afer   nil
			      'remix-status        'remix-default
			      'rear-nonsticky      t)
			 str)
    (insert str)
    (goto-char p)))

(defun remix-delete-cursor ()
  (when (get-text-property (point) 'remix-cursor)
    (delete-region (point) (1+ (point)))))

(defun remix-delete-fence ()
  (let ((inhibit-read-only t)
	p1 p2 p3)
    ;; Open fence を削除
    (setq p2 (remix-search-beginning-seq))
    (setq p1 (remix-search-beginning-fence p2))
    (delete-region p1 p2)

    ;; フェンス内のプロパティを削除
    (setq p2 (remix-search-end-seq))
    (remove-text-properties p1 p2 (text-properties-at p1))

    ;; Close fence を削除
    (setq p3 (remix-search-end-fence p2))
    (delete-region p2 p3)

    ;; 漢字変換に備えて、フェンスの両端を返す
    (cons p1 p2)))

(defun remix-search-beginning-fence (&optional from)
  (let ((p (or from (point))))
    (previous-single-property-change p 'remix-start nil (point-min))))

(defun remix-search-beginning-seq (&optional from)
  (let ((p (or from (point))))
    (or (get-text-property (1- p) 'remix-start)
	(setq p (previous-single-property-change p 'remix-start)))
    p))

(defun remix-search-end-fence (&optional from)
  (let ((p (or from (point))))
    (next-single-property-change p 'remix-end nil (point-max))))

(defun remix-search-end-seq (&optional from)
  (let ((p (or from (point))))
    (or (get-text-property p 'remix-end)
	(setq p (next-single-property-change p 'remix-end)))
    p))

(defun remix-initialize ()
  "必要ならばシステム辞書とユーザ辞書を読み込み、参照に備える"
  (save-excursion
    ;; システム辞書のセッティング
    (if remix-sysdict
	(let ((dictfiles remix-sysdict)
	      file
	      (buf (get-buffer remix-sysdictbuf)))
	  (if (null buf)
	      (progn
		(setq buf (get-buffer-create remix-sysdictbuf))
		(set-buffer buf)
		(while (setq file (car dictfiles))
		  (if (file-readable-p file)
		      (progn
			(insert-file-contents file t)
			(goto-char (point-max))
			;; 辞書ファイルの末尾が改行ではない場合に備える
			(or (bolp)
			    (insert ?\n)))
		    (message (format
			      "ReMix: 報告: 指定されたシステム辞書 (%s) を読めませんでした"
			      file)))
		  (setq dictfiles (cdr dictfiles)))
		(set-buffer-modified-p nil)
		(setq buffer-read-only t))))) ; システム辞書は書換えない

    ;; ユーザ辞書のセッティング
    (if (and remix-usrdict (null (get-buffer remix-usrdictbuf)))
	(let ((buf (find-file-noselect remix-usrdict t)))
	  (set-buffer buf)
	  (rename-buffer remix-usrdictbuf)
	  (make-local-variable 'make-backup-files)
	  (setq make-backup-files nil))))) ; ユーザ辞書ファイルのバックアップは作らない


(defun remix-seq-indict-p (seq)
  "SEQ が辞書にあるかどうかを調べる。
ユーザ辞書にあった場合は、SEQ の綴りフラグの point を返す。
システム辞書にあった場合は remix-auto-add-entry に従ってユーザ辞書に SEQ を登録し、
綴りフラグの point を返す。また、登録しなかった場合は 0 を、見つからなければ
nil を返す"
  (save-excursion
    (let ((entry (format "^%s " (regexp-quote seq))))
      (or (if remix-usrdict
	      (progn
		(set-buffer remix-usrdictbuf)
		(goto-char (point-min))
		(re-search-forward entry nil t)) ; ユーザ辞書から検索
	    nil)
	  (if (< (length seq) 2)
	      nil			; 2文字未満は検索しない
	    (if remix-sysdict
		(progn
		  (set-buffer remix-sysdictbuf)
		  (goto-char (point-min))
		  (setq entry (format "^%s$" (regexp-quote seq)))
		  (if (re-search-forward entry nil t) ; システム辞書から検索
		      (if remix-auto-add-entry ; エントリ(seq)を自動で追加するか?
			  (remix-set-usrdict seq "0" 0)
			0)
		    nil))
	      nil))))))

(defun remix-set-usrdict (seq flag dict)
  "SEQ の綴りフラグを FLAG に変更する。
FLAG を挿入した point を返す"
  (save-excursion
    (set-buffer remix-usrdictbuf)
    (if (or (null dict)
	    (zerop dict))
	(progn
	  (goto-char (point-min))
	  (insert (format "%s %s\n" seq flag)))
      (goto-char dict)
      (end-of-line)
      (delete-region dict (point))
      (insert flag))
    (set-buffer-modified-p nil)
    (clear-visited-file-modtime)
    (setq remix-usrdict-modified t)
    (forward-word -1)
    (point)))

(defun remix-kick-convert-region-or-self-insert ()
  "状況に応じて文字を入力するか漢字変換を呼び出す。
フェンスが仮名の並びならば漢字変換を呼び出す。
さもなければフェンスを確定し、入力した文字をそのまま挿入する"
  (interactive)
  (remix-end-of-input-buffer t)
  (let ((status (get-text-property (point) 'remix-status)))
    (if (or (eq status 'remix-kanaseq)
	    (eq status 'remix-indictkana))
	;; 漢字変換
	(let ((inhibit-read-only t)
	      (cursor (buffer-substring (point) (1+ (point))))
	      region)
	  (remix-delete-cursor)
	  (save-excursion
	    (goto-char (remix-search-end-fence))
	    (insert cursor))
	  (setq region (remix-delete-fence))
	  (if (/= (car region) (cdr region))
	      (egg-convert-region (car region) (cdr region)
				  (get-text-property 0 'remix-context cursor))))
      ;; self-insert
      (let ((inhibit-read-only t)
	    (seq (get-text-property (point) 'remix-keyseq-before)))
	(delete-region (remix-search-beginning-seq) (remix-search-end-seq))
	(insert seq)
	(remix-exit-mode-internal (this-command-keys))
	(egg-do-auto-fill)))))

(defun remix-pool-conversion (newsyl oldsyl cursor)
  (its-update-latest-SYL newsyl)
  (if (and newsyl
	   (consp (cdr newsyl))
	   (not (its-kst-p (its-get-kst/t newsyl))))
      ;; DSYL
      (let ((output (its-get-output newsyl)))
	(setq its-translation-result (concat its-translation-result output))))
  cursor)

(defun remix-translate-keyseq (seq last &optional cutoff)
  (setq its-translation-result ""
	its-latest-SYL (its-initial-ISYL))
  (let ((i 0)
	(syl (its-initial-ISYL))
	;; temporally disable DING
	(its-barf-on-invalid-keyseq nil)
	(len (length seq))
	cursor)
    (if (null cutoff)
	(setq cutoff len))
    (while (< i cutoff)
      (let ((key (aref seq i))
	    (its-disable-special-action t)) ; ASCII 入力モードを抑制する
	(if (null (its-keyseq-acceptable-p (vector key) syl)) ; state-machine にない綴りか?
	    (setq its-translation-result nil
		  its-latest-SYL nil
		  i cutoff)		; 変換を中止する
	  (setq cursor (its-state-machine syl key 'remix-pool-conversion))
	  (setq i (1+ i))
	  (if cursor
	      (setq syl (its-initial-ISYL))
	    (setq syl its-latest-SYL)))))
    (if (and last (not cursor))
	(setq cursor (its-state-machine syl -1 'remix-pool-conversion)))
    (if (null its-translation-result)
	seq
      (concat its-translation-result
	      (if (not cursor)
		  (car its-latest-SYL))
	      (if (< cutoff len)
		  (substring seq cutoff))))))

(defun remix-chop-head-keyseq (seq count)
  (let ((i 0)
	(syl (its-initial-ISYL))
	(its-barf-on-invalid-keyseq nil)
	(len (length seq))
	(loop 0)
	cursor)
    (while (and (< i len) (not (zerop count)))
      (let ((key (aref seq i))
	    (its-disable-special-action t))
	(setq loop 0
	      cursor (its-state-machine syl key
					(lambda (newsyl oldsyl cursor)
					  (its-update-latest-SYL newsyl)
					  (if (and newsyl
						   (consp (cdr newsyl))
						   (not (its-kst-p (its-get-kst/t newsyl))))
					      (setq count (1- count)))
					  (setq loop (1+ loop))
					  cursor)))
	(setq i (1+ i))
	(if cursor
	    (setq syl (its-initial-ISYL))
	  (setq syl its-latest-SYL))))
    (if (> loop 1)
	(setq i (1- i)))
    (substring seq i)))

(defun remix-save-dict ()
  (if (and remix-usrdict-modified
	   (get-buffer remix-usrdictbuf))
      (save-excursion
	(set-buffer remix-usrdictbuf)
	(write-file remix-usrdict))))

(defun remix-mode ()
  "\\{remix-its-mode-map}"
  ;; dummy function to get docstring
  )

(defun remix-mode-help-command ()
  "Display documentation for Egg ReMix mode."
  (interactive)
  (with-output-to-temp-buffer "*Help*"
    (princ "Egg ReMix mode:\n")
    (princ (documentation 'remix-mode))
    (help-setup-xref (cons #'help-xref-mode (current-buffer)) (interactive-p))))

;;; フック設定
(add-hook 'input-method-after-insert-chunk-hook 'remix-delete-cursor)
(add-hook 'egg-enter/leave-fence-hook 'remix-enter/leave-fence)
(add-hook 'kill-emacs-hook 'remix-save-dict)

;;; 各種パッケージ用ワークアラウンド
(defadvice message-tamago-not-in-use-p
  (around message-remix-not-in-use-p (pos) activate)
  "Gnusのメッセージ作成バッファで日本語が入力できるようにする"
  (setq ad-return-value (not (or (memq (get-text-property pos 'intangible)
				       '(remix-part-1 remix-part-2))
				 (get-text-property pos 'remix-overlay)
				 (get-text-property pos 'remix-context)
				 (get-text-property pos 'remix-keyseq-before)
				 (get-text-property pos 'remix-keyseq-after)
				 (get-text-property pos 'remix-status)
				 (get-text-property pos 'egg-end)
				 (get-text-property pos 'egg-lang)
				 (get-text-property pos 'egg-start)))))

(defadvice remix-self-insert-char
  (around remix-self-insert-char-mew-attach activate)
  "Mewの添付領域で透過的にコマンドを実行できるようにする"
  (if (and (fboundp 'mew-in-attach-p)
	   (mew-in-attach-p))
      (funcall (lookup-key mew-draft-attach-map (this-command-keys)))
    ad-do-it))

(provide 'egg-remix)

;;; egg-remix.el ends here