;;; 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.
;;; 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 ()
+(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)
(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))
\f
(defvar egg-conversion-open "|")
(defvar egg-conversion-close "|")
;;
(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)
+ (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)
+ s (point)
+ e (point))
+ (while (and (< e (point-max))
+ (equal lang (get-text-property e 'egg-lang)))
+ (setq e (next-single-property-change e '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)
+ ;; 1st pass -- mark undefined Chinese part
+ (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)))))
+ ;; 2nd pass -- set language property
+ (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"))))
+\f
(defvar egg-conversion-face nil)
(defvar egg-conversion-map
(let ((map (make-sparse-keymap))
(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)
(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")
(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))))
+ (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")
- (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))))
(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+)
(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)))
+ (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)
- (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)))
+ (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 (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))
projects / elisp / egg.git / blobdiff