-;;; egg-cnv.el --- Conversion Backend in Egg Input Method Architecture
+pn;;; 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).
+;; This file is part of EGG.
-;; 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:
+(require 'egg-edep)
+
+(defvar egg-current-language)
+(make-variable-buffer-local 'egg-current-language)
+(put 'egg-current-language 'permanent-local t)
+
(defsubst egg-bunsetsu-info () 'intangible)
+
+(defun egg-get-bunsetsu-info (p &optional object)
+ (let ((bunsetsu-info (get-text-property p (egg-bunsetsu-info) object)))
+ (if bunsetsu-info
+ (setq egg-conversion-backend (get-text-property p 'egg-backend object)
+ egg-current-language (get-text-property p 'egg-lang object)))
+ bunsetsu-info))
;;
+(defconst egg-conversion-backend-other-languages
+ [ egg-init-other-languages
+
+ egg-start-conversion-other-languages
+ egg-get-bunsetsu-converted-other-languages
+ egg-get-bunsetsu-source-other-languages
+ egg-list-candidates-other-languages
+ egg-get-number-of-candidates-other-languages
+ egg-get-current-candidate-number-other-languages
+ egg-get-all-candidates-other-languages
+ egg-decide-candidate-other-languages
+ egg-change-bunsetsu-length-other-languages
+ egg-end-conversion-other-languages
+ nil
+
+ egg-fini-other-languages
+ ])
+
+(defun egg-init-other-languages ()
+ )
+
+(defun egg-start-conversion-other-languages (yomi-string language)
+ (setq egg-conversion-backend egg-conversion-backend-other-languages)
+ (list yomi-string))
+(defun egg-get-bunsetsu-converted-other-languages (bunsetsu-info)
+ bunsetsu-info)
+(defun egg-get-bunsetsu-source-other-languages (bunsetsu-info)
+ bunsetsu-info)
+(defun egg-list-candidates-other-languages (bunsetsu-info prev-bunsetsu-info)
+ 1)
+(defun egg-get-number-of-candidates-other-languages (bunsetsu-info)
+ 1)
+(defun egg-get-current-candidate-number-other-languages (bunsetsu-info)
+ 0)
+(defun egg-get-all-candidates-other-languages (bunsetsu-info)
+ (list bunsetsu-info))
+(defun egg-decide-candidate-other-languages (bunsetsu-info candidate-pos)
+ bunsetsu-info)
+(defun egg-change-bunsetsu-length-other-languages (b0 b1 b2 len)
+ (let ((s (concat b1 b2)))
+ (set-text-properties 0 (length s) nil s)
+ (if (= len (length s))
+ (list s)
+ (list (substring s 0 len) (substring s len)))))
+(defun egg-end-conversion-other-languages (bunsetsu-info-list abort)
+ nil)
+(defun egg-fini-other-languages (language)
+ nil)
+
+(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)
-(defun egg-initialize-backend ()
+(defvar egg-finalize-backend-alist nil)
+
+(defun egg-set-current-backend (language)
+ (setq egg-conversion-backend
+ (cdr (assq language egg-conversion-backend-alist)))
+ (if (null egg-conversion-backend)
+ (setq egg-conversion-backend egg-conversion-backend-other-languages)))
+
+(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 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-end-conversion (bunsetsu-info-list abort)
+ (funcall (aref egg-conversion-backend 10) bunsetsu-info-list abort))
+(defun egg-start-reverse-conversion (yomi-string language)
+ (egg-set-current-backend language)
+ (if (aref egg-conversion-backend 11)
+ (funcall (aref egg-conversion-backend 11) yomi-string language)
+ (beep)))
(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)))))
+
+(defun egg-set-conversion-backend (backend langs &optional force)
+ (let (pair)
+ (if backend
+ (setq egg-conversion-backend backend)
+ (setq backend egg-conversion-backend))
+ (while langs
+ (setq pair (assoc (car langs) egg-conversion-backend-alist))
+ (cond
+ ((null pair)
+ (setq egg-conversion-backend-alist
+ (cons (cons (car langs) backend) egg-conversion-backend-alist)))
+ (force
+ (setcdr pair backend)))
+ (setq pair (cons (aref backend (1- (length backend))) (car langs)))
+ (if (null (assoc pair egg-finalize-backend-alist))
+ (setq egg-finalize-backend-alist
+ (cons (list pair) egg-finalize-backend-alist)))
+ (setq langs (cdr langs)))))
\f
-(defvar egg-conversion-open "|")
-(defvar egg-conversion-close "|")
+(defvar egg-conversion-open "|" "*\e$B%U%'%s%9$N;OE@$r<($9J8;zNs\e(B (1 \e$BJ8;z0J>e\e(B)")
+(defvar egg-conversion-close "|" "*\e$B%U%'%s%9$N=*E@$r<($9J8;zNs\e(B (1 \e$BJ8;z0J>e\e(B)")
+(defvar egg-conversion-face nil "*\e$B%U%'%s%9I=<($KMQ$$$k\e(B face \e$B$^$?$O\e(B nil")
+(defvar egg-conversion-invisible nil)
(defvar egg-conversion-separator " ")
+(defun egg-get-conversion-face ()
+ (let ((face (and (listp egg-conversion-face)
+ (or (assq egg-current-language egg-conversion-face)
+ (assq t egg-conversion-face)))))
+ (if face (cdr face) egg-conversion-face)))
+
;;
(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))))
+ (let ((source (buffer-substring start end))
+ (no-prop-source (buffer-substring-no-properties start end))
+ bunsetsu-info-list len result i j s)
+ (if (>= start end)
+ ;; nothing to do
+ nil
+ (delete-region start end)
+ (let ((inhibit-read-only t))
+ (its-define-select-keys egg-conversion-map)
+ (goto-char start)
+ ;; XXX: Why make OPEN&CLOSE string every time when
+ ;; this function is invoked? Any Reason?
+ ;; For me it's matter of user costomization
+ ;; of setting egg-conversion-open/egg-conversion-close
+ ;; it can be string of properties at the beginning, isn't it?
+ (setq s (copy-sequence egg-conversion-open)
+ len (length s))
+ (set-text-properties 0 len
+ (list
+ 'read-only t
+ 'egg-start t
+ 'egg-source source)
+ s)
+ (if egg-conversion-invisible
+ (put-text-property 0 len 'invisible t s))
+ (insert s)
+ (setq start (point)
+ s (copy-sequence egg-conversion-close)
+ len (length s))
+ (set-text-properties 0 len
+ '(read-only t rear-nonsticky t egg-end t)
+ s)
+ (if egg-conversion-invisible
+ (put-text-property 0 len 'invisible t s))
+ (insert s)
+ (goto-char start)
+ (egg-separate-languages (copy-sequence source))
+ (setq i 0
+ len (length source))
+ (while (< i len)
+ (setq egg-current-language (get-text-property i 'egg-lang source)
+ j (egg-next-single-property-change i 'egg-lang source len))
+ (condition-case result
+ (setq bunsetsu-info-list (egg-start-conversion
+ (substring no-prop-source i j)
+ egg-current-language))
+ (error ; XXX: catching all error is BADBADBAD
+ (setq bunsetsu-info-list (egg-start-conversion-other-languages
+ (substring no-prop-source i j)
+ egg-current-language))
+ (message "egg %s backend: %s"
+ egg-current-language (nth 1 result))))
+ (egg-insert-bunsetsu-list bunsetsu-info-list
+ (if (< j len) 'contine t))
+ (setq i j))
+ (goto-char start)))))
+
+(defconst egg-chinese-sisheng-regexp
+ (concat "[" (list (make-char 'chinese-sisheng 32))
+ "-" (list (make-char 'chinese-sisheng 127))
+ "]+"))
-(defvar egg-conversion-face nil)
+(defun egg-separate-languages (str &optional last-lang)
+ (let (lang last-chinese
+ (len (length str)) i j l)
+ ;; 1st pass -- mark undefined Chinese part
+ (if (or (eq last-lang 'Chinese-GB) (eq last-lang 'Chinese-CNS))
+ (setq last-chinese last-lang))
+ (setq i 0)
+ (while (< i len)
+ (setq j (egg-next-single-property-change i 'egg-lang str len))
+ (if (get-text-property i 'egg-lang str)
+ nil
+ (setq c (egg-string-to-char-at str i)
+ cset (char-charset c))
+ (cond
+ ((eq cset 'chinese-sisheng)
+ (string-match egg-chinese-sisheng-regexp str i)
+ (setq l (match-end 0)
+ j (min j l)
+ lang 'Chinese))
+ ((setq l (egg-chinese-syllable str i))
+ (setq j (+ i l)
+ lang 'Chinese))
+ ((eq cset 'ascii)
+ (if (eq (string-match "[\0-\177\240-\377]+" str (1+ i)) (1+ i))
+ (setq j (match-end 0))
+ (setq j (1+ i)))
+ (if (and (< j len)
+ (eq (char-charset (egg-string-to-char-at str j))
+ 'chinese-sisheng))
+ (setq j (max (1+ i) (- j 6))))
+ (setq lang nil))
+ ((eq cset 'composition)
+ (setq j (+ i (egg-char-bytes c))
+ lang (egg-charset-to-language
+ (char-charset
+ (car (decompose-composite-char c 'list))))))
+ (t
+ (string-match (concat "[" (list (make-char cset 32 32))
+ "-" (list (make-char cset 127 127))
+ "]+")
+ str i)
+ (setq j (match-end 0)
+ lang (egg-charset-to-language cset))))
+ (if lang
+ (put-text-property i j 'egg-lang lang str)))
+ (setq i j))
+ ;; 2nd pass -- set language property
+ (setq i 0)
+ (while (< i len)
+ (setq lang (get-text-property i 'egg-lang str))
+ (cond
+ ((null lang)
+ (setq lang (or last-lang
+ (egg-next-part-lang str i))))
+ ((equal lang 'Chinese)
+ (setq lang (or last-chinese
+ (egg-next-chinese-lang str i)))))
+ (setq last-lang lang)
+ (if (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS))
+ (setq last-chinese lang))
+ (setq j i
+ i (egg-next-single-property-change i 'egg-lang str len))
+ (set-text-properties j i (list 'egg-lang lang) str))))
+
+;;; Should think again the interface to language-info-alist
+(defun egg-charset-to-language (charset)
+ (let ((list language-info-alist))
+ (while (and list
+ (null (memq charset (assq 'charset (car list)))))
+ (setq list (cdr list)))
+ (if list
+ (intern (car (car list))))))
+
+(defun egg-next-part-lang (str pos)
+ (let ((lang (get-text-property
+ (egg-next-single-property-change pos 'egg-lang str (length str))
+ 'egg-lang str)))
+ (if (eq lang 'Chinese)
+ (egg-next-chinese-lang str pos)
+ (or lang
+ its-current-language
+ egg-default-language))))
+
+(defun egg-next-chinese-lang (str pos)
+ (let ((len (length str)) lang)
+ (while (and (< pos len) (null lang))
+ (setq pos (egg-next-single-property-change pos 'egg-lang str len)
+ lang (get-text-property pos 'egg-lang str))
+ (if (null (or (eq lang 'Chinese-GB)
+ (eq lang 'Chinese-CNS)))
+ (setq lang nil)))
+ (cond
+ (lang lang)
+ ((eq its-current-language 'Chinese-GB) 'Chinese-GB)
+ ((eq its-current-language 'Chinese-CNS) 'Chinese-CNS)
+ ((eq egg-default-language 'Chinese-GB) 'Chinese-GB)
+ ((eq egg-default-language 'Chinese-CNS) 'Chinese-CNS)
+ (t 'Chinese-GB))))
+\f
(defvar egg-conversion-map
(let ((map (make-sparse-keymap))
(i 33))
(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-n" 'egg-next-candidate)
(define-key map "\C-o" 'egg-enlarge-bunsetsu)
(define-key map "\C-p" 'egg-previous-candidate)
+ (define-key map "\C-r" 'egg-reverse-convert-bunsetu)
+ (define-key map "\M-r" 'egg-reconvert-bunsetsu)
(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.")
+(fset 'egg-conversion-map egg-conversion-map)
+
(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
+(defun egg-make-bunsetsu (bunsetsu-info last)
+ (let ((bunsetsu (copy-sequence (egg-get-bunsetsu-converted bunsetsu-info)))
+ len len1)
+ (setq len1 (length bunsetsu))
+ (if (null (eq last t))
+ (setq bunsetsu (concat bunsetsu egg-conversion-separator)))
+ (setq len (length bunsetsu))
+ (set-text-properties 0 len
+ (list 'read-only t
(egg-bunsetsu-info) bunsetsu-info
- 'egg-bunsetsu-last last))))
+ 'egg-backend egg-conversion-backend
+ 'egg-lang egg-current-language
+ 'egg-bunsetsu-last last
+ 'local-map 'egg-conversion-map)
+ bunsetsu)
+ (if egg-conversion-face
+ (egg-set-face 0 len1 (egg-get-conversion-face) bunsetsu))
+ bunsetsu))
-(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)
+ bunsetsu-info bunsetsu)
(while l
(setq bunsetsu-info (car l)
l (cdr l)
- p (point))
- (egg-insert-bunsetsu bunsetsu-info (and (null l) (null contin))))))
+ bunsetsu (cons (egg-make-bunsetsu bunsetsu-info
+ (and (null l) last))
+ bunsetsu)))
+ (apply 'insert (nreverse bunsetsu)))) ; XXX: Should avoid apply and reverse
+
+(defun egg-beginning-of-conversion-buffer (n)
+ (interactive "p")
+ (cond
+ ((<= n 0)
+ (egg-end-of-conversion-buffer 1))
+ ((null (get-text-property (1- (point)) 'egg-start))
+ (goto-char (previous-single-property-change (1- (point)) 'egg-start)))))
+
+(defun egg-end-of-conversion-buffer(n)
+ (interactive "p")
+ (cond
+ ((<= n 0)
+ (egg-beginning-of-conversion-buffer 1))
+ (t
+ (goto-char (next-single-property-change (point) 'egg-end))
+ (backward-char))))
(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 (egg-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 (egg-chars-in-period str j n))
+ (setq m 1 n (egg-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)))
+ (let* ((inhibit-read-only t)
+ (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))
- (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))))
+(defvar egg-conversion-wrap-select nil
+ "*Candidate selection wraps around to first candidate, if non-nil.
+Otherwise stop at the last candidate.")
+
(defun egg-next-candidate (n)
(interactive "p")
- (let ((last (get-text-property (point) 'egg-bunsetsu-last))
- (b (get-text-property (point) (egg-bunsetsu-info)))
+ (let ((inhibit-read-only t)
+ (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+)
(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 (null max+)
+ (setq beep t)
+ (cond
+ ((< i 0) ; go backward as if it is ring
+ (while (< i 0)
+ (setq i (+ i max+))))
+ ((< i max+)) ; OK
+ (egg-conversion-wrap-select ; go backward as if it is ring
+ (while (>= i max+)
+ (setq i (- i max+))))
+ ((setq i (1- max+) ; don't go forward
+ beep t)))
+ (setq new (egg-decide-candidate b i))
+ (setq p (point))
+ (delete-region p (progn (forward-char) (point)))
+ (insert (egg-make-bunsetsu new last))
+ (goto-char p))
(if beep
(ding))))
(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-reconvert-bunsetsu-internal (n func)
+ (let ((inhibit-read-only t)
+ (p (point))
+ source last bunsetsu-list)
+ (if (<= n 0)
+ (beep)
+ (while (and (null last) (> n 0))
+ (setq source (concat source
+ (egg-get-bunsetsu-converted
+ (egg-get-bunsetsu-info (point))))
+ last (get-text-property (point) 'egg-bunsetsu-last)
+ n (1- n))
+ (forward-char))
+ (cond
+ ((> n 0)
+ (beep))
+ ((setq bunsetsu-list (funcall func source egg-current-language))
+ (delete-region p (point))
+ (egg-insert-bunsetsu-list bunsetsu-list (if (eq last t) t 'contine))
+ (goto-char p)
+ (if (egg-get-previous-bunsetsu p)
+ (progn
+ (backward-char)
+ (put-text-property (point) p 'egg-bunsetsu-last 'contine)
+ (forward-char))))))))
+
+(defun egg-reverse-convert-bunsetu (n)
+ (interactive "p")
+ (egg-reconvert-bunsetsu-internal n 'egg-start-reverse-conversion))
+
+(defun egg-reconvert-bunsetsu (n)
+ (interactive "p")
+ (egg-reconvert-bunsetsu-internal n 'egg-start-conversion))
(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 ((inhibit-read-only t)
+ start end len decided undecided bunsetsu source)
+ (setq start (if (get-text-property (1- (point)) 'egg-start)
+ (point)
+ (previous-single-property-change (point) 'egg-start))
+ end (if (get-text-property (point) 'egg-end)
+ (point)
+ (next-single-property-change (point) 'egg-end))
+ decided (buffer-substring start (point))
+ undecided (buffer-substring (point) end))
+ (delete-region (- start (length egg-conversion-open))
+ (+ end (length egg-conversion-close)))
+ (setq i 0
+ len (length decided))
+ (while (< i len)
+ (setq bunsetsu (cons (egg-get-bunsetsu-info i decided) bunsetsu)
+ i (egg-next-single-property-change
+ i (egg-bunsetsu-info) decided len))
+ (if (or (= i len)
+ (get-text-property (1- i) 'egg-bunsetsu-last decided))
+ (progn
+ (setq bunsetsu (nreverse bunsetsu))
+ (apply 'insert (mapcar (lambda (b) (egg-get-bunsetsu-converted b))
+ bunsetsu))
+ (egg-end-conversion bunsetsu nil)
+ (setq bunsetsu nil))))
+ (setq len (length undecided))
+ (if (= len 0)
+ (progn
+ (egg-do-auto-fill)
+ (run-hooks 'input-method-after-insert-chunk-hook))
+ (setq i 0)
+ (while (< i len)
+ (setq source (cons (egg-get-bunsetsu-source
+ (egg-get-bunsetsu-info i undecided))
+ source)
+ i (egg-next-single-property-change
+ i (egg-bunsetsu-info) undecided len)))
+ (its-restart (apply 'concat (nreverse source)) t))))
(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)
+ (let ((inhibit-read-only t) source)
+ (goto-char (- (if (get-text-property (1- (point)) 'egg-start)
+ (point)
+ (previous-single-property-change (point) 'egg-start))
+ (length egg-conversion-open)))
+ (setq source (get-text-property (point) 'egg-source))
+ (delete-region (point) (+ (next-single-property-change (point) 'egg-end)
+ (length egg-conversion-close)))
+ (its-restart source)
+ (its-end-of-input-buffer)))
(defun egg-select-candidate ()
(interactive)
- (let ((last (get-text-property (point) 'egg-bunsetsu-last))
- (b (get-text-property (point) (egg-bunsetsu-info)))
+ (let ((inhibit-read-only t)
+ (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))
(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 "\e$B8uJd\e(B:" 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))))
+ (let (candidate-list candidate l)
+ (if (null max+)
+ ;; fake 1 candidate
+ (menudiag-select (list 'menu "\e$B8uJd\e(B:"
+ (list (egg-get-bunsetsu-converted b))
+ (list (egg-get-bunsetsu-converted b))))
+ (setq candidate-list (egg-get-all-candidates b)
+ l candidate-list
+ candidate (menudiag-select (list 'menu "\e$B8uJd\e(B:" 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)))
+ (insert (egg-make-bunsetsu new last))
+ (goto-char p)))))
+
+(defun egg-conversion-mode ()
+ "\\{egg-conversion-map}"
+ ;; dummy function to get docstring
+ )
+
+(defun egg-help-command ()
+ "Display documentation for EGG Conversion mode."
+ (interactive)
+ (with-output-to-temp-buffer "*Help*"
+ (princ "EGG Conversion mode:\n")
+ (princ (documentation 'egg-conversion-mode))
+ (help-setup-xref (cons #'help-xref-mode (current-buffer)) (interactive-p))))
(provide 'egg-cnv)
;;; egg-cnv.el ends here.
projects / elisp / egg.git / blobdiff