;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
;; Keywords: mule, multilingual, input method
-;; This file is part of EGG.
+;; 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
;;; 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)))
+(defun egg-get-bunsetsu-info (p)
+ (let ((bunsetsu-info (get-text-property p (egg-bunsetsu-info))))
(if bunsetsu-info
- (setq egg-conversion-backend (get-text-property p 'egg-backend object)
- egg-current-language (get-text-property p 'egg-lang object)))
+ (setq egg-conversion-backend (get-text-property p 'egg-backend)
+ egg-current-language (get-text-property p 'egg-lang)))
bunsetsu-info))
;;
(defconst egg-conversion-backend-other-languages
[ egg-init-other-languages
- egg-start-conversion-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-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
)
(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-set-current-backend (language)
(setq egg-conversion-backend
- (cdr (assq language egg-conversion-backend-alist)))
+ (cdr (assoc language egg-conversion-backend-alist)))
(if (null egg-conversion-backend)
(setq egg-conversion-backend egg-conversion-backend-other-languages)))
(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)))))
+ (or (assoc egg-current-language egg-conversion-face)
+ (assoc t egg-conversion-face)))))
(if face (cdr face) egg-conversion-face)))
;;
(defun egg-convert-region (start end)
(interactive "r")
- (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)
- (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
- (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))
- "]+"))
-
-(defun egg-separate-languages (str &optional last-lang)
- (let (lang last-chinese
- (len (length str)) i j l)
+ (if (>= start end)
+ ;; nothing to do
+ nil
+ (remove-text-properties start end '(read-only nil intangible nil))
+ (goto-char start)
+ (insert egg-conversion-open)
+ (let ((inhibit-read-only t)
+ (max (make-marker))
+ bunsetsu-info-list contin p s e result)
+ (setq p (+ (point) (- end start)))
+ (set-text-properties start (point)
+ (list
+ 'read-only t
+ 'egg-start t
+ 'egg-source (buffer-substring (point) p)))
+ (if egg-conversion-face
+ (put-text-property start (point) 'invisible t))
+ (setq start (point))
+ (goto-char p)
+ (insert egg-conversion-close)
+ (set-text-properties p (point) '(read-only t rear-nonsticky t egg-end t))
+ (if egg-conversion-face
+ (put-text-property p (point) 'invisible t))
+ (set-marker max p)
+ (egg-separate-languages start max)
+ (goto-char start)
+ (while (< (point) max)
+ (setq egg-current-language (get-text-property (point) 'egg-lang)
+ s (point)
+ e (point))
+ (while (and (< e max)
+ (equal egg-current-language
+ (get-text-property e 'egg-lang)))
+ (setq e (next-single-property-change e 'egg-lang nil max)))
+ (condition-case result
+ (setq bunsetsu-info-list
+ (egg-start-conversion
+ (buffer-substring-no-properties s e)
+ egg-current-language))
+ (error ; XXX: catching all error is BADBADBAD
+ (setq egg-conversion-backend egg-conversion-backend-other-languages
+ bunsetsu-info-list (egg-start-conversion-other-languages
+ (buffer-substring-no-properties s e)
+ egg-current-language))
+ (message "egg %s backend: %s" egg-current-language (cadr result))))
+ (setq contin (< e max))
+ (delete-region s e)
+ (egg-insert-bunsetsu-list bunsetsu-info-list
+ (if (< (point) max) 'contine t)))
+ (set-marker max nil)
+ (goto-char start))))
+
+(defun egg-separate-languages (start end &optional use-context)
+ (let (lang last-lang last-chinese p pe l c cset)
;; 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))
+ (goto-char start)
+ (and use-context
+ (setq last-lang (get-text-property (1- (point)) 'egg-lang))
+ (or (equal last-lang "Chinese-GB") (equal last-lang "Chinese-CNS"))
+ (setq last-chinese last-lang))
+ (while (< (point) end)
+ (setq p (point)
+ pe (next-single-property-change (point) 'egg-lang nil end))
+ (cond
+ ((get-text-property (point) 'egg-lang)
+ (goto-char pe)
+ (setq lang nil))
+ ((setq l (egg-chinese-syllable (buffer-substring p pe)))
+ (goto-char (+ p l))
+ (setq lang "Chinese"))
+ ((progn
+ (setq c (following-char)
+ cset (char-charset c))
+ (eq cset 'chinese-sisheng))
+ (forward-char)
+ (setq lang "Chinese"))
+ ((eq cset 'ascii)
+ (skip-chars-forward "\0-\177" pe)
+ (if (eq (char-charset (following-char)) 'chinese-sisheng)
+ (goto-char (max (1+ pp) (- (point) 6))))
+ (setq lang nil))
+ ((eq cset 'composition)
+ (forward-char)
+ (setq lang (egg-charset-to-language
+ (char-charset (car (decompose-composite-char c 'list))))))
+ (t
+ (skip-chars-forward (concat (vector (make-char cset 33 33))
+ "-"
+ (vector (make-char cset 127 127)))
+ pe)
+ (setq lang (egg-charset-to-language cset))))
+ (if lang
+ (put-text-property p (point) 'egg-lang lang)))
;; 2nd pass -- set language property
- (setq i 0)
- (while (< i len)
- (setq lang (get-text-property i 'egg-lang str))
+ (goto-char start)
+ (while (< (point) end)
+ (setq lang (get-text-property (point) 'egg-lang))
(cond
((null lang)
(setq lang (or last-lang
- (egg-next-part-lang str i))))
- ((equal lang 'Chinese)
+ (egg-next-part-lang end))))
+ ((equal lang "Chinese")
(setq lang (or last-chinese
- (egg-next-chinese-lang str i)))))
+ (egg-next-chinese-lang end)))))
(setq last-lang lang)
- (if (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS))
+ (if (or (equal lang "Chinese-GB") (equal 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))))
+ (setq p (point))
+ (goto-char (next-single-property-change (point) 'egg-lang nil end))
+ (set-text-properties p (point) (list 'egg-lang lang)))))
(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)
+ (car (car list))))
+
+(defun egg-next-part-lang (end)
+ (let* ((p (next-single-property-change (point) 'egg-lang nil end))
+ (lang (get-text-property p 'egg-lang)))
+ (if (equal lang "Chinese")
+ (egg-next-chinese-lang end)
(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)))
+(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 'egg-lang nil end))
+ (setq lang (get-text-property p 'egg-lang))
+ (if (null (or (equal lang "Chinese-GB")
+ (equal 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))))
+ ((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
+(require 'its-keydef)
+
(defvar egg-conversion-map
(let ((map (make-sparse-keymap))
(i 33))
(define-key map [right] 'egg-forward-bunsetsu)
(define-key map [left] 'egg-backward-bunsetsu)
(define-key map " " 'egg-next-candidate)
+ (its-define-select-keys map)
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-make-bunsetsu (bunsetsu-info last)
- (let ((bunsetsu (copy-sequence (egg-get-bunsetsu-converted bunsetsu-info)))
- len len1)
- (setq len1 (length bunsetsu))
+(defun egg-insert-bunsetsu (bunsetsu-info last)
+ (let ((bunsetsu (egg-get-bunsetsu-converted bunsetsu-info))
+ (p (point)) p1)
+ (insert bunsetsu)
+ (setq p1 (point))
(if (null (eq last t))
- (setq bunsetsu (concat bunsetsu egg-conversion-separator)))
- (setq len (length bunsetsu))
- (set-text-properties 0 len
+ (insert egg-conversion-separator))
+ (set-text-properties p (point)
(list 'read-only t
(egg-bunsetsu-info) bunsetsu-info
'egg-backend egg-conversion-backend
'egg-lang egg-current-language
'egg-bunsetsu-last last
- 'local-map 'egg-conversion-map)
- bunsetsu)
+ 'local-map egg-conversion-map))
(if egg-conversion-face
- (egg-set-face 0 len1 (egg-get-conversion-face) bunsetsu))
- bunsetsu))
+ (put-text-property p p1 'face (egg-get-conversion-face)))))
(defun egg-insert-bunsetsu-list (bunsetsu-info-list &optional last)
(let ((l bunsetsu-info-list)
- bunsetsu-info bunsetsu)
+ bunsetsu-info)
(while l
(setq bunsetsu-info (car l)
- l (cdr l)
- bunsetsu (cons (egg-make-bunsetsu bunsetsu-info
- (and (null l) last))
- bunsetsu)))
- (apply 'insert (nreverse bunsetsu))))
+ l (cdr l))
+ (egg-insert-bunsetsu bunsetsu-info (and (null l) last)))))
(defun egg-beginning-of-conversion-buffer (n)
(interactive "p")
(egg-get-bunsetsu-info (- p 2))))
(defun egg-separate-characters (str)
- (let* ((v (egg-string-to-vector 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 (egg-chars-in-period str j n))
- (setq m 1 n (egg-char-bytes (aref v i))))
+ (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))
(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 ((inhibit-read-only t)
(setq i (egg-get-current-candidate-number b))
(setq i (+ n i)))
(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 beep t)
+ (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)))
- (insert (egg-make-bunsetsu new last))
+ (egg-insert-bunsetsu new last)
(goto-char p))
(if beep
(ding))))
(interactive "p")
(egg-reconvert-bunsetsu-internal n 'egg-start-conversion))
+;; XXX: not working. Should change protocol to backend?
(defun egg-decide-before-point ()
(interactive)
(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)
+ (len (length egg-conversion-open))
+ bunsetsu-list bl (p (point)) source lang s)
+ (save-restriction
+ (if (null (get-text-property (1- (point)) 'egg-start))
+ (goto-char (previous-single-property-change (point) 'egg-start)))
+ (narrow-to-region (- (point) len) p)
+ (setq bunsetsu-list (setq bl (list nil)))
+ (while (< (point) (point-max))
+ ;; delete sparator/open marker
+ (delete-region (- (point) len) (point))
+ (setq len 1
+ bl (setcdr bl (list (egg-get-bunsetsu-info (point)))))
+ (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)
+ (set-text-properties p (point) nil)))
+ (if (cdr bunsetsu-list)
+ (egg-end-conversion (cdr bunsetsu-list)))
+ (if (get-text-property (point) 'egg-end)
(progn
+ ;; delete close marker
+ (delete-region (point) (+ (point) (length egg-conversion-close)))
(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))))
+ ;; delete from last speparater
+ (delete-region (1- (point)) (point))
+ (setq source "")
+ (while (null (get-text-property (point) 'egg-end))
+ (setq s (egg-get-bunsetsu-source (egg-get-bunsetsu-info (point))))
+ (put-text-property 0 (length s) 'egg-lang egg-current-language s)
+ (setq source (concat source s))
+ (setq p (point))
+ (forward-char)
+ (delete-region p (point)))
+ ;; delete close marker
+ (delete-region (point) (+ (point) (length egg-conversion-close)))
+ (its-restart source t))))
+
+(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
+ read-only 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-exit-conversion ()
(interactive)
- (goto-char (next-single-property-change (point) 'egg-end))
- (egg-decide-before-point))
+ (let ((inhibit-read-only t)
+ 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 (+ start (length egg-conversion-open)))
+ (setq bunsetsu-list (egg-decide-bunsetsu))
+ ;; Delete close marker
+ (delete-region (point) (+ (point) (length egg-conversion-close)))
+ (egg-end-conversion bunsetsu-list nil)
+ (egg-do-auto-fill)
+ (run-hooks 'input-method-after-insert-chunk-hook)))
(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)))
+ (let ((inhibit-read-only t)
+ start bunsetsu-list source)
+ (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)
(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)))
+ ;; Delete open marker
+ (delete-region start (+ start (length egg-conversion-open)))
+ (setq bunsetsu-list (egg-decide-bunsetsu))
+ ;; Delete close marker
+ (delete-region (point) (+ (point) (length egg-conversion-close)))
+ (egg-end-conversion bunsetsu-list t)
+ (delete-region start (point))
+ (its-restart source)))
(defun egg-select-candidate ()
(interactive)
(setq new (egg-decide-candidate b i))
(setq p (point))
(delete-region p (progn (forward-char) (point)))
- (insert (egg-make-bunsetsu new last))
+ (egg-insert-bunsetsu new last)
(goto-char p)))))
(provide 'egg-cnv)
projects / elisp / egg.git / blobdiff