;;; egg-cnv.el --- Conversion Backend in Egg Input Method Architecture

;; Copyright (C) 1997 Mule Project,
;; Powered by Electrotechnical Laboratory, JAPAN.
;; Project Leader: Satoru Tomura <tomura@etl.go.jp>

;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
;; Keywords: mule, multilingual, input method

;; This file will be part of GNU Emacs (in future).

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

;; GNU Emacs 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:

(defsubst egg-bunsetsu-info () 'intangible)
;;

(defvar egg-conversion-backend nil)

(defun egg-initialize-backend ()
  (funcall (aref egg-conversion-backend 0)))

(defun egg-start-conversion (yomi-string)
  (funcall (aref egg-conversion-backend 1) yomi-string))
(defun egg-get-bunsetsu-converted (bunsetsu-info)
  (funcall (aref egg-conversion-backend 2) bunsetsu-info))
(defun egg-get-bunsetsu-source (bunsetsu-info)
  (funcall (aref egg-conversion-backend 3) bunsetsu-info))
(defun egg-list-candidates (bunsetsu-info prev-bunsetsu-info)
  (funcall (aref egg-conversion-backend 4) bunsetsu-info prev-bunsetsu-info))
(defun egg-get-number-of-candidates (bunsetsu-info)
  (funcall (aref egg-conversion-backend 5) bunsetsu-info))
(defun egg-get-current-candidate-number (bunsetsu-info)
  (funcall (aref egg-conversion-backend 6) bunsetsu-info))
(defun egg-get-all-candidates (bunsetsu-info)
  (funcall (aref egg-conversion-backend 7) bunsetsu-info))
(defun egg-decide-candidate (bunsetsu-info candidate-pos)
  (funcall (aref egg-conversion-backend 8) bunsetsu-info candidate-pos))
(defun egg-change-bunsetsu-length (b0 b1 b2 len)
  (funcall (aref egg-conversion-backend 9) b0 b1 b2 len))
(defun egg-end-conversion (bunsetsu-info-list)
  (funcall (aref egg-conversion-backend 10) bunsetsu-info-list))

(defun egg-finalize-backend ()
  (funcall (aref egg-conversion-backend 11)))

(defvar egg-conversion-open "|")
(defvar egg-conversion-close "|")
(defvar egg-conversion-separator " ")

;;
(defun egg-convert-region (start end)
  (interactive "r")
  (let ((bunsetsu-info-list
	 (egg-start-conversion (buffer-substring start end)))
	p)
    (delete-region start end)
    (setq p (point))
    (insert egg-conversion-open)
    (put-text-property p (point) 'egg-start t)
    (if egg-conversion-face
	(put-text-property p (point) 'invisible t))
    ;;
    (egg-insert-bunsetsu-list bunsetsu-info-list)
    ;;
    (setq p (point))
    (insert egg-conversion-close)
    (put-text-property p (point) 'egg-end t)
    (if egg-conversion-face
	(put-text-property p (point) 'invisible t))
    (goto-char (1+ start))))

(defvar egg-conversion-face nil)
(defvar egg-conversion-map
  (let ((map (make-sparse-keymap))
	(i 33))
    (while (< i 127)
      (define-key map (vector i) 'egg-exit-conversion-unread-char)
      (setq i (1+ i)))
    (define-key map "\C-@" 'egg-decide-first-char)
    (define-key map [?\C-\ ] 'egg-decide-first-char)
    (define-key map "\C-a"   'egg-beginning-of-conversion-buffer)
    (define-key map "\C-b"   'egg-backward-bunsetsu)
    (define-key map "\C-e"   'egg-end-of-conversion-buffer)
    (define-key map "\C-f"   'egg-forward-bunsetsu)
    (define-key map "\C-h"   'egg-help-command)
    (define-key map "\C-i"   'egg-shrink-bunsetsu)
    (define-key map "\C-k"   'egg-decide-before-point)
;;    (define-key map "\C-l"   'egg-exit-conversion)  ; Don't override C-L
    (define-key map "\C-m"   'egg-exit-conversion)
    (define-key map "\C-n"   'egg-next-candidate)
    (define-key map "\C-o"   'egg-enlarge-bunsetsu)
    (define-key map "\C-p"   'egg-previous-candidate)
    (define-key map "\M-s"   'egg-select-candidate)
    (define-key map [return] 'egg-exit-conversion)
;;    (define-key map "\C-\\"  'egg-exit-mode-no-egg)
    (define-key map [right]  'egg-forward-bunsetsu)
    (define-key map [left]   'egg-backward-bunsetsu)
    (define-key map " "      'egg-next-candidate)
    (define-key map "/"      'egg-exit-conversion)
    map)
  "Keymap for EGG Conversion mode.")

(defun egg-exit-conversion-unread-char ()
  (interactive)
  (setq unread-command-events (list last-command-event))
  (egg-exit-conversion))

(defun egg-insert-bunsetsu (bunsetsu-info last)
  (let ((bunsetsu (egg-get-bunsetsu-converted bunsetsu-info))
	(p (point)))
    (insert bunsetsu)
    (if (not last)
	(insert egg-conversion-separator))
    (add-text-properties p (point)
			 (list 'face      egg-conversion-face
			       'local-map egg-conversion-map
			       (egg-bunsetsu-info) bunsetsu-info
			       'egg-bunsetsu-last last))))

(defun egg-insert-bunsetsu-list (bunsetsu-info-list &optional contin)
  (let ((l bunsetsu-info-list)
	bunsetsu-info bunsetsu p)
    (while l
      (setq bunsetsu-info (car l)
	    l (cdr l)
	    p (point))
      (egg-insert-bunsetsu bunsetsu-info (and (null l) (null contin))))))

(defun egg-backward-bunsetsu (n)
  (interactive "p")
  (let (start)
    (while (and (null start) (> n 0))
      (backward-char)
      (if (setq start (get-text-property (point) 'egg-start))
	  (forward-char)
	(setq n (1- n))))
    (if (> n 0)
	(signal 'beginning-of-buffer nil))))

(defun egg-forward-bunsetsu (n)
  (interactive "p")
  (let (end)
    (while (and (null end) (> n 0))
      (forward-char)
      (if (setq end (get-text-property (point) 'egg-end))
	  (backward-char)
	(setq n (1- n))))
    (if (> n 0)
	(signal 'end-of-buffer nil))))

(defun egg-get-previous-bunsetsu (p)
  (if (get-text-property (1- p) 'egg-start)
      nil
    (get-text-property (- p 2) (egg-bunsetsu-info))))

(defun egg-shrink-bunsetsu (n)
  (interactive "p")
  (let* ((b0 (egg-get-previous-bunsetsu (point)))
	 (b1 (get-text-property (point) (egg-bunsetsu-info)))
	 (last (get-text-property (point) 'egg-bunsetsu-last))
	 (slen (chars-in-string (egg-get-bunsetsu-source b1)))
	 (newlen (- slen n))
	 b2 bunsetsu-info-list beep)
    (if (< newlen 1)
	(setq beep t
	      newlen 1))
    (if (not last)
	(let ((p2 (save-excursion (forward-char) (point))))
	  (setq b2 (get-text-property p2 (egg-bunsetsu-info))
		last (get-text-property p2 'egg-bunsetsu-last))))
    (setq bunsetsu-info-list (egg-change-bunsetsu-length b0 b1 b2 newlen))
    (delete-region (point)
		   (progn (forward-char) (if b2 (forward-char)) (point)))
    (let ((p (point)))
      (egg-insert-bunsetsu-list bunsetsu-info-list (not last))
      (goto-char p))
    (if beep
	(ding))))

(defun egg-enlarge-bunsetsu (n)
  (interactive "p")
  (let* ((b0 (egg-get-previous-bunsetsu (point)))
	 (b1 (get-text-property (point) (egg-bunsetsu-info)))
	 (last (get-text-property (point) 'egg-bunsetsu-last))
	 (slen (chars-in-string (egg-get-bunsetsu-source b1)))
	 (newlen (+ slen n))
	 b2 maxlen bunsetsu-info-list beep)
    (if (not last)
	(let ((p2 (save-excursion (forward-char) (point))))
	  (setq b2 (get-text-property p2 (egg-bunsetsu-info))
		last (get-text-property p2 'egg-bunsetsu-last))))
    (setq maxlen (+ slen
		    (if b2
			(chars-in-string (egg-get-bunsetsu-source b2))
		      0)))
    (if (> newlen maxlen)
	(setq beep t
	      newlen maxlen))
    (setq bunsetsu-info-list (egg-change-bunsetsu-length b0 b1 b2 newlen))
    (delete-region (point)
		   (progn (forward-char) (if b2 (forward-char)) (point)))
    (let ((p (point)))
      (egg-insert-bunsetsu-list bunsetsu-info-list (not last))
      (goto-char p))
    (if beep
	(ding))))

(defun egg-next-candidate (n)
  (interactive "p")
  (let ((last (get-text-property (point) 'egg-bunsetsu-last))
	(b (get-text-property (point) (egg-bunsetsu-info)))
	new i max+ p beep)
    (setq max+ (egg-get-number-of-candidates b))
    (if (null max+)
	(let ((prev-b (egg-get-previous-bunsetsu (point))))
	  (setq i (egg-list-candidates b prev-b)) ; there is a case I=/=0
	  (if (or (> n 1) (< n 0))	; with N=/=1, start with I
	      (setq i (+ n i))		; or else (N==1),
	    (setq i (if (= i 0) 1 0)))	;   I:=1 when I was 0, or else I:=0
	  (setq max+ (egg-get-number-of-candidates b)))
      (setq i (egg-get-current-candidate-number b))
      (setq i (+ n i)))
    (if (< i 0)				; go backward as if it is ring
	(while (< i 0)
	  (setq i (+ i max+))))
    (if (>= i max+)			; don't go forward 
	(setq i (1- max+)
	      beep t))
    (setq new (egg-decide-candidate b i))
    (setq p (point))
    (delete-region p (progn (forward-char) (point)))
    (egg-insert-bunsetsu new last)
    (goto-char p)
    (if beep
	(ding))))

(defun egg-previous-candidate (n)
  (interactive "p")
  (egg-next-candidate (- n)))

(defun egg-decide-bunsetsu (&optional end-marker)
  (let ((in-loop t)
	p bunsetsu-info-list bl)
    (setq p (point))
    (while in-loop
      (let ((bl1 (cons (get-text-property p (egg-bunsetsu-info)) nil)))
	(if bl
	    (setq bl (setcdr bl bl1))
	  (setq bunsetsu-info-list (setq bl bl1))))
      (forward-char)
      (remove-text-properties p (point) '(face nil
					  intangible nil
					  local-map nil
					  egg-bunsetsu-last nil))
      (setq p (point))
      (if (or (and end-marker (= p end-marker))
	      (get-text-property p 'egg-end))
	  (setq in-loop nil)
	(setq p (1- p))
	(delete-region p (1+ p)))) 	; Delete bunsetsu separator
    bunsetsu-info-list))

(defun egg-decide-before-point ()
  (interactive)
  (let ((m (make-marker))
	all start bunsetsu-list)
    (if (get-text-property (1- (point)) 'egg-start)
	(signal 'beginning-of-buffer nil)
      (setq start (1- (previous-single-property-change (point) 'egg-start))))
    (set-marker m (point))
    (goto-char start)
    ;; Delete open marker
    (delete-region start (1+ start))
    (setq bunsetsu-list (egg-decide-bunsetsu m))
    ;; delete separator
    (delete-region (1- (point)) (point))
    ;; insert open marker
    (insert egg-conversion-open)
    (put-text-property m (point) 'egg-start t)
    (if egg-conversion-face
	(put-text-property p (point) 'invisible t))
    (egg-end-conversion bunsetsu-list)
    (set-marker m nil)))

(defun egg-exit-conversion ()
  (interactive)
  (let (start bunsetsu-list)
    (if (get-text-property (1- (point)) 'egg-start)
	(setq start (1- (point)))
      (setq start (1- (previous-single-property-change (point) 'egg-start))))
    (goto-char start)
    ;; Delete open marker
    (delete-region start (1+ start))
    (setq bunsetsu-list (egg-decide-bunsetsu))
    ;; Delete close marker
    (delete-region (point) (1+ (point)))
    (egg-do-auto-fill)
    (egg-end-conversion bunsetsu-list)
    (run-hooks 'input-method-after-insert-chunk-hook)))

(defun egg-select-candidate ()
  (interactive)
  (let ((last (get-text-property (point) 'egg-bunsetsu-last))
	(b (get-text-property (point) (egg-bunsetsu-info)))
	(in-loop t)
	new i max+ p)
    (setq max+ (egg-get-number-of-candidates b))
    (if (null max+)
	(let ((prev-b (egg-get-previous-bunsetsu (point))))
	  (setq i (egg-list-candidates b prev-b))
	  (setq max+ (egg-get-number-of-candidates b)))
      (setq i (egg-get-current-candidate-number b)))
    (let* ((candidate-list (egg-get-all-candidates b))
	   (l candidate-list)
	   (candidate (menudiag-select (list 'menu "候補:" l) (list (nth i l)))))
      (setq i 0)
      (while in-loop
	(if (eq candidate (car l))
	    (setq in-loop nil)
	  (setq l (cdr l)
		i (1+ i))))
      (setq new (egg-decide-candidate b i))
      (setq p (point))
      (delete-region p (progn (forward-char) (point)))
      (egg-insert-bunsetsu new last)
      (goto-char p))))

(provide 'egg-cnv)
;;; egg-cnv.el ends here.