;;; 「ゆでたまご」(boiled-egg.el): ローマ字漢字変換用「たまご」フロントエンド
;;; Copyright (C) 1992,1993,1994 Miura Kin'ya

;;; 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 1, 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; see the file COPYING.  If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;;	Miura Kin'ya [ Miura is my family name. ]
;;;	e-mail:	 miura@is.aist-nara.ac.jp
;;;	address: Nara Institute of Science and Technology,
;;;	         8916-5, Takayama / Ikoma, Nara 630-01 / JAPAN
;;;	phone:	 +81 7437 2 5261
;;;	fax:	 +81 7437 2 5269

;;; Log:
;;; 	3.16 [Sep 06, 1994] 'require' (for bytecompiling in mule 2.0)
;;; 	3.15 [Sep 06, 1994] disable-undo in rK-trans, JIS X0201
;;; 	3.14 [Sep 05, 1994] typo etc.
;;; 	3.13 [Sep 05, 1994] for mule 2.0
;;; 	3.12 [Apr 21, 1994] be-ignore-case, be-roma-kana-region, README.Eng
;;; 	3.11 [Jul 07, 1993] jisx0201 support
;;; 	3.10 [Jul 02, 1993] debug
;;; 	3.9 [Oct 28, 1992] rK-kakutei-before-point, README.be
;;; 	3.8 [Oct 27, 1992] hk -> K, be-display-mode, be-verbose
;;; 	3.7 [Oct 27, 1992] 'x-mode, egg-insert-after-hook, auto-fill etc.
;;; 	3.5 [Aug 27, 1992] rK-kakutei-before-point debug
;;; 	3.4 [Aug 12, 1992] rK-kakutei-before-point etc.
;;; 	3.3 [Jul 29, 1992] X-transes, rK-trans modified. (by Mr. Hoshi)
;;;	                   replace-on-keymap changed.
;;; 	3.2 [Jul 27, 1992] changed for MULE (thanks to Mr. Furuhata/Mr. Furuta)
;;; 	3.1 [Jan 17, 1992] be-mark-as-trans-begin introduced.
;;; 	3.0 [Dec 06, 1991] hard-boiled.el has not been distributed, yet.
;;; 	2.5 [Dec 07, 1990] rK-cancel-trans has modified.
;;; 	2.2 [Aug 28, 1990] 'hard-boiled' has made.
;;; 	2.1 [Aug 17, 1990] (provide ..) added.
;;; 	2.0 [Jul 06, 1990] key-binding, initialization modified.
;;; 	1.2 [Jun 22, 1990] KR-trans added.
;;; 	1.0 [Apr 23, 1990] Kh-trans, rRkh-trans(by Mr. Takahasi) added.
;;; 	0.0 [Feb 15, 1990] private version of `boiled-egg'.

;;; Special thanks to:
;;;	takahasi@etl.go.jp (高橋孝一) さん
;;;	furuhata@tamago.fujita3.iis.u-tokyo.ac.jp (Tomotake FURUHATA) さん
;;;	furuta@srarc2.sra.co.jp (古田敦) さん
;;;	hoshi@sra.co.jp (Hoshi Takanori) さん
;;;	ksakai@mtl.t.u-tokyo.ac.jp (酒井清隆) さん
;;;	mituharu@is.s.u-tokyo.ac.jp (山本光晴) さん

;;; wnn7egg & Emacs20 対応
;;;     2001/12/01 庵出版(http://www.chibutsu.org/AIC/, aic@chibutsu.org)
;;;     2001/12/19 when の使用をやめ、if に書き換え。

(defmacro if-mule (&rest args)
  (` (if (boundp 'MULE) (,@ args))))

(if (featurep 'wnn7egg) nil
  (if-mule (require 'egg) (require 'wnn-egg)))

;;;
;;;	変数等
;;;

;; マクロ
(defmacro defvar-local (var &rest args)
  "define VAR, and make it buffer local."
  (` (progn (defvar (, var) (,@ args))
	    (make-variable-buffer-local '(, var)))))

;; キーバインディング
(defvar-local rK-trans-key "\C-j" "*for `boil' only")
(defvar-local rhkR-trans-key "\ej" "*for `boil' only")
(defvar-local rRkh-trans-key "\e\C-j" "*for `boil' only")
(defvar Kh-trans-key nil "*")
(defvar KR-trans-key nil "*")

;; オプション
(defvar be-jisx0201 nil
  "*If you want to use jisx0201.el, set this variable. (mule only)")
(defvar be-verbose t
  "*If non-nil some messages are displaied in minibuffer area.")
(defvar be-ignore-case nil
  "*If non-nil cases of alphabet are ignored in transformation.")

(defvar be-mark-as-trans-begin t
  "*If non-nil 'mark' will be regarded as trans-begin.")
(defvar be-mark-trans-end nil
  "*If non-nil trans-end be marked on 'kakutei'.")
(defvar-local be-trans-begin-regexp "[^!-~]\\|[(){}]"
  "*regexp for beginning of words(- 1 char).")
(defvar-local be-trans-begin-regexp-hk
  ;; "\211\246-\211\337" は，JIS X0201 での "ヲ-゜"
  (if-mule "[^ーぁ-んァ-ヶ\211\246-\211\337]" "[^ーぁ-んァ-ヶ]")
  "*regexp for beginning of words(- 1 char) for 'hk be-trans-src-type.")

;; その他
(defconst X-transes '(rhkR-trans rRkh-trans henkan-kakutei Kh-trans KR-trans))
(defconst be-trans-mode-name
  '((r . "Aa") (hk . "混")
    ;; "\211\261" は，JIS X0201 での "ア"
    (h . "あ") (k  . "ア") (jk . "\211\261\211\261") (R . "Ａ")
    (K . "漢")
    (x . "??")))
(defvar-local be-trans-mode nil "Current mode of transformation.")
(defvar-local be-trans-begin nil "Begin marker of transfer region.")
(defvar-local be-trans-end nil "End marker of transfer region.")
(defvar-local be-trans-src "" "Source string of transfer region.")
(defvar-local be-trans-src-type nil "Character type of be-trans-src.")

;;;
;;;	初期化ルーチン
;;;

(defun boil ()
  "`boil' cooks `egg', then makes `boiled-egg'"
  (interactive)
  (local-set-key rK-trans-key 'rK-trans)
  (local-set-key rhkR-trans-key 'rhkR-trans)
  (local-set-key rRkh-trans-key 'rRkh-trans)
  (if be-trans-mode nil
    (define-key minibuffer-local-map rK-trans-key 'rK-trans)
    (define-key minibuffer-local-map rhkR-trans-key 'rhkR-trans)
    (define-key minibuffer-local-map rRkh-trans-key 'rRkh-trans)
    (define-key minibuffer-local-ns-map rK-trans-key 'rK-trans)
    (define-key minibuffer-local-ns-map rhkR-trans-key 'rhkR-trans)
    (define-key minibuffer-local-ns-map rRkh-trans-key 'rRkh-trans))
  (boiling)
  (message "boiled"))

(defun boiling ()
  "boiling (initialize of boiled-egg)"
  (if be-jisx0201 (require 'jisx0201))
  (or (memq 'be-reset-mode egg-insert-after-hook)
      (setq egg-insert-after-hook (cons 'be-reset-mode egg-insert-after-hook)))
  (if (or (>= emacs-major-version 20)
	  (and (if-mule mc-flag kanji-flag)
	       (not egg:*mode-on*)))
      (progn
	(setq egg:*mode-on* t)
	(setq egg:*input-mode* nil)
	(egg:mode-line-display)))
  (if (null (featurep 'wnn7egg))
      (progn       ;; before wnn7
	(fset 'be-wnn-henkan-quit 'henkan-quit)
	(fset 'be-wnn-henkan-kakutei-before-point 'henkan-kakutei-before-point)
	(fset 'be-wnn-henkan-next-kouho 'henkan-next-kouho)
	(fset 'be-wnn-henkan-region 'henkan-region)
	(fset 'be-wnn-hiragana-region 'hiragana-region)
	(fset 'be-wnn-katakana-region 'katakana-region)
	(fset 'be-wnn-zenkaku-region 'zenkaku-region)
	(if be-trans-mode nil
	  (replace-on-keymap henkan-mode-map 'henkan-quit 'rK-cancel-trans)
	  (replace-on-keymap henkan-mode-map
		       'henkan-kakutei-before-point 'rK-kakutei-before-point)
	  (define-similar-keys (current-local-map) 'rK-trans
			 henkan-mode-map 'henkan-next-kouho)
	  (if Kh-trans-key (define-key henkan-mode-map Kh-trans-key 'Kh-trans)
	    (define-similar-keys (current-local-map) 'rhkR-trans
			   henkan-mode-map 'Kh-trans))
	  (if KR-trans-key (define-key henkan-mode-map KR-trans-key 'KR-trans)
	    (define-similar-keys (current-local-map) 'rRkh-trans
			   henkan-mode-map 'KR-trans))
	  (setq-default be-trans-mode 'x)))
    (progn   ;; for wnn7
	(fset 'be-wnn-henkan-quit 'wnn7-henkan-quit)
	(fset 'be-wnn-henkan-kakutei-before-point 'wnn7-henkan-kakutei-before-point)
	(fset 'be-wnn-henkan-next-kouho 'wnn7-henkan-next-kouho)
	(fset 'be-wnn-henkan-region 'wnn7-henkan-region)
	(fset 'be-wnn-hiragana-region 'japanese-hiragana-region)
	(fset 'be-wnn-katakana-region 'japanese-katakana-region)
	(fset 'be-wnn-zenkaku-region 'japanese-zenkaku-region)
	(if be-trans-mode nil
	  (replace-on-keymap wnn7-henkan-mode-map 'wnn7-henkan-quit 'rK-cancel-trans)
	  (replace-on-keymap wnn7-henkan-mode-map
		       'wnn7-henkan-kakutei-before-point 'rK-kakutei-before-point)
	  (define-similar-keys (current-local-map) 'rK-trans
			 wnn7-henkan-mode-map 'wnn7-henkan-next-kouho)
	  (if Kh-trans-key (define-key wnn7-henkan-mode-map Kh-trans-key 'Kh-trans)
	    (define-similar-keys (current-local-map) 'rhkR-trans
			   wnn7-henkan-mode-map 'Kh-trans))
	  (if KR-trans-key (define-key wnn7-henkan-mode-map KR-trans-key 'KR-trans)
	    (define-similar-keys (current-local-map) 'rRkh-trans
			   wnn7-henkan-mode-map 'KR-trans))
	  (setq-default be-trans-mode 'x)))))

(defun replace-on-keymap (map old new)
  "on a keymap (MAP), replace command OLD with another command NEW"
  (define-similar-keys map old map new))

(defun define-similar-keys (map1 com1 map2 com2)
  "args: KEYMAP1, COMMAND1, KEYMAP2, COMMAND2.
define key sequences, which are defined in KEYMAP1 as COMMAND1,
in KEYMAP2 as COMMAND2"
  (mapcar (function (lambda (seq) (define-key map2 seq com2)))
	  (where-is-internal com1 map1)))

;;;
;;;	補助関数
;;;

(defun mark-src ()
  "mark source string for transformation, and save it to `be-trans-src'"
  (save-excursion
    (setq be-trans-end (point-marker))
    (if (< emacs-major-version 20)
	(set-marker-type be-trans-end t)
	(set-marker-insertion-type be-trans-end t))
    (if (re-search-backward be-trans-begin-regexp (point-min) 0)
      (forward-char 1))
    (if (< (point) (marker-position be-trans-end))
	(setq be-trans-src-type (setq be-trans-mode 'r))
      (if (re-search-backward be-trans-begin-regexp-hk (point-min) 0)
	  (forward-char 1))
      (if (< (point) (marker-position be-trans-end))
	  (setq be-trans-src-type (setq be-trans-mode 'hk))))
    (and (marker-position (mark-marker))
	 be-mark-as-trans-begin
	 (< (point) (mark t))
	 (< (mark t) (marker-position be-trans-end))
	 (goto-char (mark t)))
    (setq be-trans-begin (point-marker))
    (setq be-trans-src (buffer-substring (point)
					 (marker-position be-trans-end)))))

(defun cancel-trans ()
  "Cancel transformation."
  (goto-char (marker-position be-trans-begin))
  (insert be-trans-src)
  (delete-region (point) (marker-position be-trans-end)))

(defun be-display-mode ()
  (if (and be-verbose (zerop (minibuffer-depth)) (not (eq be-trans-mode 'x)))
      (message "[%s]:%s"
	       (cdr (assq be-trans-mode be-trans-mode-name))
	       be-trans-src)))

(defun be-reset-mode ()
  (if (eq be-trans-mode 'x) nil
    (if be-mark-trans-end
	(set-mark (if (eq be-trans-mode 'K) (point) (1- (point)))))
    (egg:do-auto-fill)
    (setq be-trans-mode 'x)))

(defun be-roma-kana-region (begin end)
  (if be-ignore-case (downcase-region begin end))
  (roma-kana-region begin end))

;;;
;;;	漢字変換
;;;

(defun rK-trans ()
  "(roman(hankaku) or hiragana/ktakana) -> KANJI transformation."
  (interactive)
  (boiling)
  (let ((finished nil))
    (unwind-protect
	(progn
	  (setq disable-undo t)
	  (if (memq last-command X-transes) (cancel-trans) (mark-src))
	  (if (string-match "^ *$" be-trans-src)
	      (progn
		(setq be-trans-mode 'x)
		(setq disable-undo nil))
	    (setq be-trans-mode 'K) ; henkan-mode is `K-mode.'
	    (cond
	     ((eq be-trans-src-type 'r)
	      (be-roma-kana-region (marker-position be-trans-begin)
				   (marker-position be-trans-end)))
	     ((eq be-trans-src-type 'hk)
	      (if be-jisx0201
		  (zenkaku-katakana-region (marker-position be-trans-begin)
					   (marker-position be-trans-end)))
	      (be-wnn-hiragana-region (marker-position be-trans-begin)
				      (marker-position be-trans-end))))
	    (be-wnn-henkan-region (marker-position be-trans-begin)
				  (marker-position be-trans-end)))
	  (be-display-mode)
	  (setq finished t))
      (or finished (setq disable-undo nil)))))

(defun rK-cancel-trans()
  "cancel KANJI transformation (KANJI -> roman(hankaku) or hiragana/ktakana)."
  (interactive)
  (be-wnn-henkan-quit)
  (if (not (eq be-trans-mode 'K)) nil
    (fence-cancel-input)
    (if (featurep 'wnn7egg) (fence-toggle-egg-mode))
    (insert be-trans-src)
    (setq be-trans-mode 'x)
    (setq disable-undo nil)))

(defun rK-kakutei-before-point ()
  "boiled-egg version of henkan-kakutei-before-point."
  (interactive)
  (be-wnn-henkan-kakutei-before-point)
  (if (not (eq be-trans-mode 'K)) nil
    (fence-exit-mode)
    (let* ((begin (point))
	   (rest (buffer-substring begin (marker-position be-trans-end))))
      (insert be-trans-src)
      (delete-region (point) (marker-position be-trans-end))
      (cond
       ((eq be-trans-src-type 'r)
		(be-roma-kana-region begin (marker-position be-trans-end)))
       ((eq be-trans-src-type 'hk)
		(if be-jisx0201
		    (zenkaku-katakana-region begin
					     (marker-position be-trans-end)))
		(be-wnn-hiragana-region begin (marker-position be-trans-end))))
      (while (not (string=
		   (buffer-substring begin (marker-position be-trans-end))
		   rest))
	(cond
	 ((eq be-trans-src-type 'r)
		(setq be-trans-src (substring be-trans-src 1))
		(goto-char begin)
		(insert be-trans-src)
		(delete-region (point) (marker-position be-trans-end))
		(be-roma-kana-region begin (marker-position be-trans-end)))
	 ((eq be-trans-src-type 'hk)
		(setq be-trans-src (substring be-trans-src (if-mule 3 2)))
		(goto-char begin)
		(insert be-trans-src)
		(delete-region (point) (marker-position be-trans-end))
		(if be-jisx0201
		    (zenkaku-katakana-region begin
					     (marker-position be-trans-end)))
		(be-wnn-hiragana-region begin (marker-position be-trans-end)))))
      (move-marker be-trans-begin begin)
      (cancel-trans)
      (setq be-trans-mode 'x)
      (setq disable-undo nil))))

(defun Kh-trans ()
  "cancel KANJI transformation and transform to hiragana
(KANJI -> hiragana)."
  (interactive)
  (rK-cancel-trans)
  (rhkR-trans))

(defun KR-trans ()
  "cancel KANJI transformation and transform to ROMAN(zenkaku)
(KANJI -> ROMAN(ZENKAKU)),
or transform to katakana (KANJI -> katakana)."
  (interactive)
  (rK-cancel-trans)
  (rRkh-trans))

;;;
;;;	半角 -> ひらがな -> カタカナ -> 全角 (-> 半角) 変換
;;;	かな混合 -> ひらがな -> カタカナ (-> かな混合) 変換
;;;

(defun rhkR-trans ()
  "roman(hankaku) -> hiragana -> katakana -> ROMAN(zenkaku) transformation
or hiragana/katakana -> hiragana -> katakana transformation."
  (interactive)
  (boiling)
  (if (not (memq last-command X-transes)) (mark-src))
  (cond
   ((= be-trans-begin be-trans-end) nil)
   ((eq be-trans-src-type 'r)
	(cond
	 ((eq be-trans-mode 'r)
		(be-roma-kana-region (marker-position be-trans-begin)
				     (marker-position be-trans-end))
		(setq be-trans-mode 'h))
	 ((eq be-trans-mode 'h)
		(be-wnn-katakana-region (marker-position be-trans-begin)
					(marker-position be-trans-end))
		(setq be-trans-mode 'k))
	 ((and be-jisx0201 (eq be-trans-mode 'k))
		(hankaku-katakana-region (marker-position be-trans-begin)
					 (marker-position be-trans-end))
		(setq be-trans-mode 'jk))
	 ((or (eq be-trans-mode 'k) (eq be-trans-mode 'jk))
		(cancel-trans)
		(be-wnn-zenkaku-region (marker-position be-trans-begin)
				       (marker-position be-trans-end))
		(setq be-trans-mode 'R))
	 (t	(cancel-trans)
		(setq be-trans-mode 'r))))
   ((eq be-trans-src-type 'hk)
	(cond
	 ((eq be-trans-mode 'hk)
		(if be-jisx0201
		    (zenkaku-katakana-region (marker-position be-trans-begin)
					     (marker-position be-trans-end)))
		(be-wnn-hiragana-region (marker-position be-trans-begin)
					(marker-position be-trans-end))
		(setq be-trans-mode 'h))
	 ((eq be-trans-mode 'h)
		(be-wnn-katakana-region (marker-position be-trans-begin)
					(marker-position be-trans-end))
		(setq be-trans-mode 'k))
	 ((and be-jisx0201 (eq be-trans-mode 'k))
		(hankaku-katakana-region (marker-position be-trans-begin)
					 (marker-position be-trans-end))
		(setq be-trans-mode 'jk))
	 (t	(cancel-trans)
		(setq be-trans-mode 'hk)))))
  (be-display-mode))

;;;
;;;	半角 -> 全角 -> カタカナ -> ひらがな (-> 半角) 変換
;;;	かな混合 -> カタカナ -> ひらがな (-> かな混合) 変換
;;;

(defun rRkh-trans ()
  "roman(hankaku) -> ROMAN(zenkaku) -> katakana -> hiragana transformation
or hiragana/katakana -> katakana -> hiragana transformation."
  (interactive)
  (boiling)
  (if (not (memq last-command X-transes)) (mark-src))
  (cond
   ((= be-trans-begin be-trans-end) nil)
   ((eq be-trans-src-type 'r)
	(cond
	 ((eq be-trans-mode 'r)
		(be-wnn-zenkaku-region (marker-position be-trans-begin)
				       (marker-position be-trans-end))
		(setq be-trans-mode 'R))
	 ((eq be-trans-mode 'R)
		(cancel-trans)
		(be-roma-kana-region (marker-position be-trans-begin)
				     (marker-position be-trans-end))
		(be-wnn-katakana-region (marker-position be-trans-begin)
					(marker-position be-trans-end))
		(if (not be-jisx0201) (setq be-trans-mode 'k)
		  (hankaku-katakana-region (marker-position be-trans-begin)
					   (marker-position be-trans-end))
		  (setq be-trans-mode 'jk)))
	 ((eq be-trans-mode 'jk)
		(zenkaku-katakana-region  (marker-position be-trans-begin)
					  (marker-position be-trans-end))
		(setq be-trans-mode 'k))
	 ((eq be-trans-mode 'k)
		(be-wnn-hiragana-region (marker-position be-trans-begin)
					(marker-position be-trans-end))
		(setq be-trans-mode 'h))
	 (t	(cancel-trans)
		(setq be-trans-mode 'r))))
   ((eq be-trans-src-type 'hk)
	(cond
	 ((eq be-trans-mode 'hk)
		(be-wnn-katakana-region (marker-position be-trans-begin)
					(marker-position be-trans-end))
		(if (not be-jisx0201) (setq be-trans-mode 'k)
		  (hankaku-katakana-region (marker-position be-trans-begin)
					   (marker-position be-trans-end))
		  (setq be-trans-mode 'jk)))
	 ((eq be-trans-mode 'jk)
		(zenkaku-katakana-region  (marker-position be-trans-begin)
					  (marker-position be-trans-end))
		(setq be-trans-mode 'k))
	 ((eq be-trans-mode 'k)
		(be-wnn-hiragana-region (marker-position be-trans-begin)
					(marker-position be-trans-end))
		(setq be-trans-mode 'h))
	 (t	(cancel-trans)
		(setq be-trans-mode 'hk)))))
  (be-display-mode))

;;;
(provide 'boiled-egg)