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

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

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

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

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

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

(defun egg-get-bunsetsu-info (p)
  (let ((info (get-text-property p (egg-bunsetsu-info))))
    (cond
     ((consp info)
      (setq egg-conversion-backend (car info))
      (cdr info)))))
;;

(defvar egg-conversion-backend-alist nil)
(make-variable-buffer-local 'egg-conversion-backend-alist)
(defvar egg-conversion-backend nil)
(make-variable-buffer-local 'egg-conversion-backend)

(defvar egg-finalize-backend-alist nil)

(defun egg-set-current-backend (language)
  (let ((backend (assoc lang  egg-conversion-backend-alist)))
    (if (null backend)
	(error "%S is not supported" lang)
      (setq egg-conversion-backend (cdr backend)))))

(defun egg-initialize-backend (language)
  (egg-set-current-backend language)
  (funcall (aref egg-conversion-backend 0)))

(defun egg-start-conversion (yomi-string language)
  (egg-set-current-backend language)
  (funcall (aref egg-conversion-backend 1) yomi-string language))
(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 ()
  (let ((alist egg-finalize-backend-alist))
    (while alist
      (funcall (car (car (car alist))) (cdr (car (car alist))))
      (setq alist (cdr alist)))))

(defmacro egg-set-conversion-backend-internal (backend langs &optional force)
  `(let ((l ,langs) pair)
     (while l
       (setq pair (assoc (car l) egg-conversion-backend-alist))
       (if (null pair)
	   (setq egg-conversion-backend-alist 
		 (cons (cons (car l) ,backend)
		       egg-conversion-backend-alist))
	 ,(if force `(setcdr pair ,backend)))
       (setq pair (cons (aref ,backend 11) (car l)))
       (if (null (assoc pair egg-finalize-backend-alist))
	   (setq egg-finalize-backend-alist
		 (cons (list pair) egg-finalize-backend-alist)))
       (setq l (cdr l)))))

(defun egg-set-conversion-backend (backend curent-langs other-langs)
  (egg-set-conversion-backend-internal backend curent-langs t)
  (egg-set-conversion-backend-internal backend other-langs))

(defvar egg-conversion-open "|")
(defvar egg-conversion-close "|")
(defvar egg-conversion-separator " ")

;;
(defun egg-convert-region (start end)
  (interactive "r")
  (let (bunsetsu-info-list lang contin p s e)
    (save-restriction
      (narrow-to-region start end)
      (goto-char start)
      (insert egg-conversion-open)
      (add-text-properties start (point)
			   (list
			    'egg-start t
			    'egg-source (buffer-substring (point)
							  (point-max))))
      (if egg-conversion-face
          (put-text-property start (point) 'invisible t))
      (setq start (point))
      (egg-separate-languages start (point-max))
      (goto-char start)
      (while (< (point) (point-max))
	(setq lang (get-text-property (point) 'egg-lang))
	(setq s (point)
	      e (next-single-property-change s 'egg-lang nil (point-max)))
	(setq bunsetsu-info-list
	      (egg-start-conversion (buffer-substring s e) lang))
	(setq contin (< e (point-max)))
	(delete-region s e)
	(egg-insert-bunsetsu-list bunsetsu-info-list
				  (if (< (point) (point-max)) 'contine t))))
    (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 start)))

(defun egg-separate-languages (start end)
  (let (lang last-lang last-chinese p l c cset)
    (goto-char start)
    (while (< (point) end)
      (setq p (next-single-property-change (point) 'its-lang nil end))
      (cond
       ((get-text-property (point) 'its-lang)
	(goto-char p))
       ((setq l (egg-chinese-syllable (buffer-substring (point) p)))
	(setq p (point))
	(goto-char (+ (point) l))
	(put-text-property p (point) 'its-lang "Chinese"))
       ((progn
	  (setq c (following-char)
		cset (char-charset c))
	  (eq cset 'chinese-sisheng))
	(setq p (point))
	(forward-char)
	(put-text-property p (point) 'its-lang "Chinese"))
       ((eq cset 'ascii)
	(forward-char))
       (t
	(setq p (point))
	(forward-char)
	(put-text-property p (point) 'its-lang (egg-char-to-language c)))))
    (goto-char start)
    (while (< (point) end)
      (setq lang (get-text-property (point) 'its-lang))
      (cond
       ((null lang)
	(setq lang (or last-lang
		       (egg-next-part-lang end))))
       ((equal lang "Chinese")
	(setq lang (or last-chinese
		       (egg-next-chinese-lang end)))))
      (setq last-lang lang)
      (if (or (equal lang "Chinese-GB") (equal lang "Chinese-CNS"))
	  (setq last-chinese lang))
      (setq p (point))
      (goto-char (next-single-property-change (point) 'its-lang nil end))
      (set-text-properties p (point) (list 'egg-lang lang)))))

(defun egg-char-to-language (c)
  (let ((charset (char-charset c))
	(list language-info-alist))
    (while (and list
		(null (memq charset (assq 'charset (car list)))))
      (setq list (cdr list)))
    (car (car list))))

(defun egg-next-part-lang (end)
  (let* ((p (next-single-property-change (point) 'its-lang nil end))
	 (lang (get-text-property p 'its-lang)))
    (if (equal lang "Chinese")
	(egg-next-chinese-lang end)
      (or lang
	  its-current-language
	  egg-default-language))))

(defun egg-next-chinese-lang (end)
  (let (p lang)
    (setq p (point))
    (while (and (< p end) (null lang))
      (setq p (next-single-property-change p 'its-lang nil end))
      (setq lang (get-text-property p 'its-lang))
      (if (null (or (equal lang "Chinese-GB")
		    (equal lang "Chinese-CNS")))
	  (setq lang nil)))
    (cond
     (lang lang)
     ((or (equal its-current-language "Chinese-GB")
	  (equal its-current-language "Chinese-CNS"))
      its-current-language)
     ((or (equal egg-default-language "Chinese-GB")
	  (equal egg-default-language "Chinese-CNS"))
      egg-default-language)
     (t "Chinese-GB"))))

(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-c"   'egg-abort-conversion)
    (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 (null (eq last t))
	(insert egg-conversion-separator))
    (add-text-properties p (point)
			 (list 'face      egg-conversion-face
			       'local-map egg-conversion-map
			       (egg-bunsetsu-info) (cons egg-conversion-backend
							 bunsetsu-info)
			       'egg-bunsetsu-last last))))

(defun egg-insert-bunsetsu-list (bunsetsu-info-list &optional last)
  (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) last)))))

(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)
  (and (null (get-text-property (1- p) 'egg-start))
       (null (get-text-property (1- p) 'egg-bunsetsu-last))
       (egg-get-bunsetsu-info (- p 2))))

(defun egg-separate-characters (str)
  (let* ((v (string-to-vector str))
	 (len (length v))
	 (i 0) (j 0) m n (nchar 0))
    (while (< i len)
      (if (setq n (egg-chinese-syllable str j))
	  (setq m (chars-in-string (substring str j (+ j n))))
	(setq m 1 n (char-bytes (aref v i))))
      (put-text-property j (+ j n) 'egg-char-size n str)
      (setq nchar (1+ nchar) i (+ i m) j (+ j n)))
    nchar))

(defun egg-shrink-bunsetsu (n)
  (interactive "p")
  (egg-enlarge-bunsetsu (- n)))

(defun egg-enlarge-bunsetsu (n)
  (interactive "p")
  (let* ((b0 (egg-get-previous-bunsetsu (point)))
	 (b1 (egg-get-bunsetsu-info (point)))
	 (s1 (egg-get-bunsetsu-source b1))
	 (s1len (egg-separate-characters s1))
	 (s2len 0)
	 (chrs (length s1))
	 (last (get-text-property (point) 'egg-bunsetsu-last))
	 b2 s2 source bunsetsu-info-list beep)
    (if (not last)
	(let ((p2 (save-excursion (forward-char) (point))))
	  (setq b2 (egg-get-bunsetsu-info p2)
		s2 (egg-get-bunsetsu-source b2)
		s2len (egg-separate-characters s2)
		last (get-text-property p2 'egg-bunsetsu-last))))
    (setq source (concat s1 s2))
    (cond
     ((<= n (- s1len))
      (setq beep t chrs (get-text-property 0 'egg-char-size source)))
     ((> n s2len)
      (setq beep t chrs (length source)))
     ((< n 0)
      (while (< n 0)
	(setq chrs (- chrs (get-text-property (1- chrs) 'egg-char-size source))
	      n (1+ n))))
     (t
      (while (> n 0)
	(setq chrs (+ chrs (get-text-property chrs 'egg-char-size source))
	      n (1- n)))))
    (setq bunsetsu-info-list (egg-change-bunsetsu-length b0 b1 b2 chrs))
    (delete-region (point)
		   (progn (forward-char) (if b2 (forward-char)) (point)))
    (let ((p (point)))
      (egg-insert-bunsetsu-list bunsetsu-info-list last)
      (goto-char p))
    (if beep
	(ding))))

(defun egg-next-candidate (n)
  (interactive "p")
  (let ((last (get-text-property (point) 'egg-bunsetsu-last))
	(b (egg-get-bunsetsu-info (point)))
	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)))

;; Bogus function 980220
(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 (egg-get-bunsetsu-info p) 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 (bunsetsu-list bl (p (point)) source (dlen 0) l s)
    (save-restriction
      (if (null (get-text-property (1- (point)) 'egg-start))
	  (goto-char (previous-single-property-change (point) 'egg-start)))
      (narrow-to-region (1- (point)) p)
      (setq source (get-text-property (1- (point)) 'egg-source))
      (setq bunsetsu-list (setq bl (list nil)))
      (while (< (point) (point-max))
	;; delete sparator/open marker
	(delete-region (1- (point)) (point))
	(setq bl (setcdr bl (list (egg-get-bunsetsu-info (point)))))
	(setq dlen (+ dlen (length (egg-get-bunsetsu-source (car bl)))))
	(if (get-text-property (point) 'egg-bunsetsu-last)
	    (progn
	      (egg-end-conversion (cdr bunsetsu-list))
	      (setq bunsetsu-list (setq bl (list nil)))))
	(setq p (point))
	(forward-char)
	(remove-text-properties p (point) '(face nil
						 intangible nil
						 local-map nil
						 egg-bunsetsu-last nil))))
    (if (get-text-property (point) 'egg-end)
	(progn
	  ;; delete close marker
	  (delete-region (point) (1+ (point)))
	  (egg-do-auto-fill)
	  (run-hooks 'input-method-after-insert-chunk-hook))
      ;; delete last from speparater to close marker
      (delete-region (1- (point))
		     (1+ (next-single-property-change (point) 'egg-end)))
      ;; rebuild fence mode string
      (setq p 0)
      (while (< p dlen)
	(setq s (car (get-text-property p 'its-syl source))
	      l (length s)
	      p (+ p l))
	(if (> p dlen)
	    (put-text-property dlen p
			       'its-syl (list (substring s (- dlen p)))
			       source)))
      (its-restart (substring source dlen)))))

(defun egg-exit-conversion ()
  (interactive)
  (goto-char (next-single-property-change (point) 'egg-end))
  (egg-decide-before-point))

(defun egg-abort-conversion ()
  (interactive)
  (if (null (get-text-property (1- (point)) 'egg-start))
      (goto-char (previous-single-property-change (point) 'egg-start)))
  (egg-decide-before-point))

(defun egg-select-candidate ()
  (interactive)
  (let ((last (get-text-property (point) 'egg-bunsetsu-last))
	(b (egg-get-bunsetsu-info (point)))
	(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.