X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fegg.git;a=blobdiff_plain;f=egg-cnv.el;h=76a748bb23da5b41e1a071cbc57a8841866473b8;hp=249ff9de01d82b14155f0b60d8b66112fe4e2052;hb=4f60a801e4c8a70a1eb7299c4fdd6f8c75f8528f;hpb=051cd863eb34b98b099d4c8ccfd4327b4de9564c

diff --git a/egg-cnv.el b/egg-cnv.el
index 249ff9d..76a748b 100644
--- a/egg-cnv.el
+++ b/egg-cnv.el
@@ -1,21 +1,22 @@
 ;;; egg-cnv.el --- Conversion Backend in Egg Input Method Architecture
 
-;; Copyright (C) 1997 Mule Project,
+;; 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).
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
 
-;; GNU Emacs is distributed in the hope that it will be useful,
+;; 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.
@@ -31,15 +32,35 @@
 ;;; 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-initialize-backend ()
+(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)
-  (funcall (aref egg-conversion-backend 1) yomi-string))
+(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)
@@ -60,7 +81,29 @@
   (funcall (aref egg-conversion-backend 10) bunsetsu-info-list))
 
 (defun egg-finalize-backend ()
-  (funcall (aref egg-conversion-backend 11)))
+  (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 "|")
@@ -69,25 +112,112 @@
 ;;
 (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)
-    ;;
+  (let (bunsetsu-info-list lang contin p s e)
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char start)
+      (insert egg-conversion-open)
+      (put-text-property start (point) 'egg-start t)
+      (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 (1+ start))))
+    (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))
@@ -128,22 +258,23 @@
   (let ((bunsetsu (egg-get-bunsetsu-converted bunsetsu-info))
 	(p (point)))
     (insert bunsetsu)
-    (if (not last)
+    (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) bunsetsu-info
+			       (egg-bunsetsu-info) (cons egg-conversion-backend
+							 bunsetsu-info)
 			       'egg-bunsetsu-last last))))
 
-(defun egg-insert-bunsetsu-list (bunsetsu-info-list &optional contin)
+(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) (null contin))))))
+      (egg-insert-bunsetsu bunsetsu-info (and (null l) last)))))
 
 (defun egg-backward-bunsetsu (n)
   (interactive "p")
@@ -170,56 +301,59 @@
 (defun egg-get-previous-bunsetsu (p)
   (if (get-text-property (1- p) 'egg-start)
       nil
-    (get-text-property (- p 2) (egg-bunsetsu-info))))
+    (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")
-  (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))))
+  (egg-enlarge-bunsetsu (- n)))
 
 (defun egg-enlarge-bunsetsu (n)
   (interactive "p")
   (let* ((b0 (egg-get-previous-bunsetsu (point)))
-	 (b1 (get-text-property (point) (egg-bunsetsu-info)))
+	 (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))
-	 (slen (chars-in-string (egg-get-bunsetsu-source b1)))
-	 (newlen (+ slen n))
-	 b2 maxlen bunsetsu-info-list beep)
+	 b2 s2 source bunsetsu-info-list beep)
     (if (not last)
 	(let ((p2 (save-excursion (forward-char) (point))))
-	  (setq b2 (get-text-property p2 (egg-bunsetsu-info))
+	  (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 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))
+    (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 (not last))
+      (egg-insert-bunsetsu-list bunsetsu-info-list last)
       (goto-char p))
     (if beep
 	(ding))))
@@ -227,7 +361,7 @@
 (defun egg-next-candidate (n)
   (interactive "p")
   (let ((last (get-text-property (point) 'egg-bunsetsu-last))
-	(b (get-text-property (point) (egg-bunsetsu-info)))
+	(b (egg-get-bunsetsu-info (point)))
 	new i max+ p beep)
     (setq max+ (egg-get-number-of-candidates b))
     (if (null max+)
@@ -262,7 +396,7 @@
 	p bunsetsu-info-list bl)
     (setq p (point))
     (while in-loop
-      (let ((bl1 (cons (get-text-property p (egg-bunsetsu-info)) nil)))
+      (let ((bl1 (cons (egg-get-bunsetsu-info p) nil)))
 	(if bl
 	    (setq bl (setcdr bl bl1))
 	  (setq bunsetsu-info-list (setq bl bl1))))
@@ -320,7 +454,7 @@
 (defun egg-select-candidate ()
   (interactive)
   (let ((last (get-text-property (point) 'egg-bunsetsu-last))
-	(b (get-text-property (point) (egg-bunsetsu-info)))
+	(b (egg-get-bunsetsu-info (point)))
 	(in-loop t)
 	new i max+ p)
     (setq max+ (egg-get-number-of-candidates b))