;; 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)
;; KATAYAMA Yoshio <kate@pfu.co.jp> ; Korean, Chinese support.
;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
-;; 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-fixed-euc 'fixed-euc-jp)
(make-variable-buffer-local 'egg-fixed-euc)
(r0 = (r1 | ?\x80))
(write-read-repeat r0)))))))))
-(define-ccl-program ccl-encode-fixed-euc-jp
+(define-ccl-program ccl-encode-fixed-euc
`(2
((read r0)
(loop
- (if (r0 == ,(charset-id 'latin-jisx0201)) ; Unify
+; (if (r0 < ?\x20)
+; (write-read-repeat r0))
+ (if (r0 == ,(charset-id 'latin-jisx0201)) ; Unify
((read r0)
(r0 &= ?\x7f)))
- (if (r0 < ?\x80) ;G0
+ (if (r0 < ?\x80)
((write 0)
(write-read-repeat r0)))
(r6 = (r0 == ,(charset-id 'japanese-jisx0208)))
(r6 |= (r0 == ,(charset-id 'japanese-jisx0208-1978)))
+ (r6 |= (r0 == ,(charset-id 'chinese-gb2312)))
+ (r6 |= (r0 == ,(charset-id 'korean-ksc5601)))
(if r6 ;G1
((read r0)
(write r0)
(read r0)
(write-read-repeat r0)))
- (if (r0 == ,(charset-id 'katakana-jisx0201)) ;G2
+ (r6 = (r0 == ,(charset-id 'katakana-jisx0201)))
+ (r6 |= (r0 == ,(charset-id 'chinese-sisheng)))
+ (if r6 ;G2
((read r0)
(write 0)
(write-read-repeat r0)))
)
(make-coding-system 'fixed-euc-jp 4 ?W "Coding System for fixed EUC Japanese"
- (cons ccl-decode-fixed-euc-jp ccl-encode-fixed-euc-jp))
+ (cons ccl-decode-fixed-euc-jp ccl-encode-fixed-euc))
;; Korean
`(2
((read r0)
(loop
+; (if (r0 < ?\x20)
+; (write-read-repeat r0))
(if (r0 < ?\x80)
((write 0)
(write-read-repeat r0)))
(if (r0 == ,(charset-id 'korean-ksc5601))
((read r0)
+ (r0 |= ?\x80)
(write r0)
(read r0)
+ (r0 |= ?\x80)
(write-read-repeat r0)))
(read r0)
(repeat)))))
?\x0000
])
-(defconst egg-chinese-syllable-max-len
- (max (length "Zhu\e(0!\e(Bng\e(0@\e(B") (length "\e(0ShdA\e(B")))
-
-(defun egg-chinese-syllable (str pos)
- (setq str (substring str pos (min (length str)
- (+ pos egg-chinese-syllable-max-len))))
+(defun egg-chinese-syllable (str &optional start)
+ (if start
+ (setq str (substring str start)))
(or (car (egg-pinyin-syllable str))
(car (egg-zhuyin-syllable str))))
(defsubst egg-make-fixed-euc-china-code (s y)
- (cons
- (+ (* 2 (nth 1 y)) (logand (nth 2 y) 1) 32)
- (+ (* 4 (if (= s 0) 20 s)) (lsh (nth 2 y) -1) 156)))
+ (concat (list
+ (+ (* 2 (nth 1 y)) (logand (nth 2 y) 1) 32)
+ (+ (* 4 (if (= s 0) 20 s)) (lsh (nth 2 y) -1) 156))))
(defun egg-pinyin-syllable (str)
(let (s y end)
- (if (eq (string-match "^[A-Za-z\e(0!\e(B-\e(0?\e(B]+\e(0@\e(B" str) 0)
+ (if (string-match "^[A-Za-z\e(0!\e(B-\e(0?\e(B]+\e(0@\e(B" str)
(progn
(setq end (match-end 0))
(cond
(cons end (egg-make-fixed-euc-china-code s y)))))))
(defun egg-zhuyin-syllable (str)
- (let (end s y c z (zhuyin-len (egg-charset-bytes 'chinese-sisheng)))
- (if (eq (string-match "^[\e(0E\e(B-\e(0i\e(B@0-4]+[\e(0@ABCD\e(B]" str) 0)
+ (let (end s y c z (zhuyin-len (charset-bytes 'chinese-sisheng)))
+ (if (string-match "^[\e(0E\e(B-\e(0i\e(B@0-4]+[\e(0@ABCD\e(B]" str)
(progn
(setq end (match-end 0)
c (substring str 0 zhuyin-len)
(defun encode-fixed-euc-china-region (beg end type)
"Encode the text in the region to EUC-CN/TW."
- (let (s syl c cset)
+ (let (s syl c cset (maxlen (max (length "Zhu\e(0!\e(Bng\e(0@\e(B") (length "\e(0ShdA\e(B"))))
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
(while (< (point) (point-max))
- (setq s (buffer-substring
- (point)
- (min (point-max) (+ (point) egg-chinese-syllable-max-len))))
+ (setq s (buffer-substring (point)
+ (min (+ (point) maxlen) (point-max))))
(cond
((setq syl (egg-pinyin-syllable s))
(delete-region (point) (+ (point) (car syl)))
- (insert (car (cdr syl)) (cdr (cdr syl))))
+ (insert (cdr syl)))
((setq syl (egg-zhuyin-syllable s))
(delete-region (point) (+ (point) (car syl)))
- (insert (car (cdr syl)) (cdr (cdr syl))))
+ (insert (cdr syl)))
(t
(setq c (split-char (following-char))
cset (car c))
((eq cset 'chinese-sisheng)
(delete-char 1)
(insert 0 (+ (nth 1 c) 128)))
- ((eq cset 'ascii)
- (delete-char 1)
- (insert 0 (nth 1 c)))
(t
- (delete-char 1))))))
+ (delete-region (point) (1+ (point)))
+ (insert 0 (nth 1 c)))))))
(- (point-max) (point-min))))))
(defun pre-write-encode-fixed-euc-china (from to type)
(work (get-buffer-create " *pre-write-encoding-work*")))
(set-buffer work)
(erase-buffer)
- (if (null (stringp from))
- (save-excursion
- (set-buffer buf)
- (setq from (buffer-substring from to))))
- (insert (string-as-multibyte from))
+ (if (stringp from)
+ (insert from)
+ (insert-buffer-substring buf from to))
(encode-fixed-euc-china-region 1 (point-max) type)
nil))
(defun decode-fixed-euc-china-region (beg end type)
"Decode EUC-CN/TW encoded text in the region.
Return the length of resulting text."
+ (interactive "r")
(prog1
- (let ((str (string-as-unibyte (buffer-substring beg end)))
- (i 0)
- l c0 c1 s y ss)
- (delete-region beg end)
- (setq l (1- (length str)))
- (while (< i l)
- (setq c0 (aref str i)
- c1 (aref str (1+ i))
- i (+ i 2))
- (cond
- ((eq c0 0)
- (if (> c1 ?\xa0)
- (insert leading-code-private-11
- (charset-id 'chinese-sisheng)
- c1)
- (insert c1)))
- ((>= c0 ?\x80)
+ (let (c0 c1 s y ss)
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (setq c1 (buffer-substring (point) (+ (point) 2))
+ c0 (aref c1 0)
+ c1 (aref c1 1))
+ (delete-region (point) (+ (point) 2))
(cond
- ((eq type 'cn)
- (insert (charset-id 'chinese-gb2312) c0 (logior c1 ?\x80)))
+ ((eq c0 0)
+ (if (> c1 ?\xa0)
+ (insert leading-code-private-11
+ (charset-id 'chinese-sisheng)
+ c1)
+ (insert c1)))
((>= c0 ?\x80)
- (insert (charset-id 'chinese-cns11643-1) c0 c1))
+ (cond
+ ((eq type 'cn)
+ (insert (charset-id 'chinese-gb2312) c0 (logior c1 ?\x80)))
+ ((>= c0 ?\x80)
+ (insert (charset-id 'chinese-cns11643-1) c0 c1))
+ (t
+ (insert (charset-id 'chinese-cns11643-2) c0 (+ c1 ?\x80)))))
(t
- (insert (charset-id 'chinese-cns11643-2) c0 (+ c1 ?\x80)))))
- (t
- (setq c1 (logand c1 ?\x7f))
- (setq s (- (lsh c1 -2) 7);;(+ (lsh (- c1 32) -2) 1)
- y (- (lsh c0 -1) 16);;(lsh (- c0 32) -1)
- ss (+ (logand c0 1) (logand c1 3)))
- (if egg-zhuyin
- (progn
- (setq c0 (aref yincode-zhuyin-table (+ (* 41 s) y)))
- (if (eq (logand c0 ?\x8080) ?\x80)
- (setq s (lsh c0 -8)
- y (logand c0 ?\x7f)))
- (if (and (eq s 20)
- (eq (aref yincode-pinyin-table (+ (* 39 s) y)) 0))
- (setq s 0))
- (setq s (car (nth s yincode-zhuyin-shengmu))
- y (car (nth (+ (* 5 y) ss) yincode-zhuyin-yunmu))))
- (if (and (eq s 20)
- (eq (aref yincode-pinyin-table (+ (* 39 s) y)) 0))
- (setq s 0))
- (setq s (car (nth s yincode-pinyin-shengmu))
- y (car (nth (+ (* 5 y) ss) yincode-pinyin-yunmu))))
- (if enable-multibyte-characters
- (insert s y)
- (insert (string-as-unibyte s) (string-as-unibyte y))))))
- (- (point) beg))
+ (setq c1 (logand c1 ?\x7f))
+ (setq s (- (lsh c1 -2) 7) ;;(+ (lsh (- c1 32) -2) 1)
+ y (- (lsh c0 -1) 16) ;;(lsh (- c0 32) -1)
+ ss (+ (logand c0 1) (logand c1 3)))
+ (if egg-zhuyin
+ (progn
+ (setq c0 (aref yincode-zhuyin-table (+ (* 41 s) y)))
+ (if (eq (logand c0 ?\x8080) ?\x80)
+ (setq s (lsh c0 -8)
+ y (logand c0 ?\x7f)))
+ (if (and (eq s 20)
+ (eq (aref yincode-pinyin-table (+ (* 39 s) y)) 0))
+ (setq s 0))
+ (insert (car (nth s yincode-zhuyin-shengmu))
+ (car (nth (+ (* 5 y) ss) yincode-zhuyin-yunmu))))
+ (if (and (eq s 20)
+ (eq (aref yincode-pinyin-table (+ (* 39 s) y)) 0))
+ (setq s 0))
+ (insert (car (nth s yincode-pinyin-shengmu))
+ (car (nth (+ (* 5 y) ss) yincode-pinyin-yunmu)))))))
+ (- (point-max) (point-min))))
(if (looking-at "\0\0") (forward-char 2))))
(defun post-read-decode-fixed-euc-china (len type)
(defun post-read-decode-euc-tw (len)
(post-read-decode-fixed-euc-china len 'tw))
-(make-coding-system 'fixed-euc-cn 0 ?W "Coding System for fixed EUC Chinese-gb2312")
-(coding-system-put 'fixed-euc-cn 'pre-write-conversion 'pre-write-encode-euc-cn)
-(coding-system-put 'fixed-euc-cn 'post-read-conversion 'post-read-decode-euc-cn)
+(make-coding-system 'fixed-euc-cn 5 ?W "Coding System for fixed EUC Chinese-gb2312")
+(put 'fixed-euc-cn 'pre-write-conversion 'pre-write-encode-euc-cn)
+(put 'fixed-euc-cn 'post-read-conversion 'post-read-decode-euc-cn)
-(make-coding-system 'fixed-euc-tw 0 ?W "Coding System for fixed EUC Chinese-cns11643")
-(coding-system-put 'fixed-euc-tw 'pre-write-conversion 'pre-write-encode-euc-tw)
-(coding-system-put 'fixed-euc-tw 'post-read-conversion 'post-read-decode-euc-tw)
+(make-coding-system 'fixed-euc-tw 5 ?W "Coding System for fixed EUC Chinese-cns11643")
+(put 'fixed-euc-tw 'pre-write-conversion 'pre-write-encode-euc-tw)
+(put 'fixed-euc-tw 'post-read-conversion 'post-read-decode-euc-tw)
\f
(defsubst comm-format-u32c (uint32c)
(let ((h0 (car uint32c))
(let ((start (point)))
(while (not (search-forward "\0\0" nil t))
(comm-accept-process-output proc))
- (set s (string-as-multibyte
- (buffer-substring start
- (+ start
- (decode-coding-region start (- (point) 2)
- egg-fixed-euc)))))))
+ (set s (buffer-substring start
+ (+ start
+ (decode-coding-region start (- (point) 2)
+ egg-fixed-euc))))))
;;; XXX should support other conversion (euc-kr, cns)
(defsubst comm-unpack-mb-string (proc s)
(let ((start (point)))
(while (not (search-forward "\0" nil t))
(comm-accept-process-output proc))
- (set s (string-as-multibyte
- (buffer-substring start
- (+ start
- (decode-coding-region start (- (point) 1)
- egg-mb-euc)))))))
+ (set s (buffer-substring start
+ (+ start
+ (decode-coding-region start (- (point) 1)
+ egg-mb-euc))))))
(defsubst comm-unpack-u8-string (proc s)
(let ((start (point)))
;; 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:
-(defvar mlh-default-backend "wnn")
-
(defun mlh-space-bar-backward-henkan ()
"If the character preceding point is / (slash),
Do `mlh-backward-henkan'. Then, invoke appropriate conversion, if needed.
(let ((henkan-begin nil)
(inhibit-henkan t)
(its-disable-special-action t))
- (if (null (assq 'Japanese egg-conversion-backend-alist))
- (progn
- (setq egg-mode-preference nil)
- (activate-input-method (concat "japanese-egg-" mlh-default-backend)))
- ;; force to Japanese
- (its-select-hiragana))
+ (its-select-hiragana) ;; force to Japanese
(mlh-backward-henkan)
(if henkan-begin
(if (or inhibit-henkan (= henkan-begin (point)))
;; 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
;;; Commentary:
;;; Code:
-(require 'egg-edep)
-
(defvar egg-mode-preference t
"Non-nil if modefull.")
-(defvar egg-default-language)
+(defvar egg-default-language "Japanese")
(defvar egg-last-method-name)
(make-variable-buffer-local 'egg-last-method-name)
(setq describe-current-input-method-function nil)
(setq current-input-method nil)
(use-local-map (keymap-parent (current-local-map)))
- (remove-hook 'input-method-activate-hook 'its-set-mode-line-title t)
(force-mode-line-update))
;; Turn on
(if (null (string= (car arg) egg-last-method-name))
(egg-modeless-map)))
(setq inactivate-current-input-method-function 'egg-mode)
(setq describe-current-input-method-function 'egg-help)
- (make-local-hook 'input-method-activate-hook)
- (add-hook 'input-method-activate-hook 'its-set-mode-line-title nil t)))
+ (add-hook 'input-method-activate-hook 'its-set-mode-line-title)))
(defun egg-modefull-map ()
"Generate modefull keymap for EGG mode."
(interactive)
(its-start last-command-char))
\f
-(defvar egg-mark-list nil)
-(defvar egg-suppress-marking nil)
-
-(defun egg-set-face (beg eng face &optional object)
- (put face 'face face)
- (add-text-properties beg eng
- (list 'category face
- 'egg-face t
- 'modification-hooks '(egg-mark-modification))
- object))
-
-(defun egg-mark-modification (beg end)
- (if (and (null egg-suppress-marking)
- (or (get-text-property beg 'egg-face)
- (setq beg (next-single-property-change beg 'egg-face)))
- (or (get-text-property (1- end) 'egg-face)
- (setq end (previous-single-property-change end 'egg-face)))
- (< beg end))
- (let ((list egg-mark-list)
- (found 0)
- pair mb me b e)
- (add-hook 'post-command-hook 'egg-redraw-face t)
- (setq list egg-mark-list)
- (while (and list (< found 2))
- (setq pair (car list)
- list (cdr list)
- mb (car pair)
- me (cdr pair)
- b (marker-position mb)
- e (marker-position me))
- (cond
- ;; no overwrapping -- SKIP
- ((or (null (eq (marker-buffer mb) (current-buffer)))
- (or (> beg e) (< end b))))
- ;; completely included
- ((and (>= beg b) (<= end e))
- (setq found 3))
- ;; partially overwrapping
- (t
- (set-marker mb nil)
- (set-marker me nil)
- (setq egg-mark-list (delete pair egg-mark-list)
- beg (min beg b)
- end (max end e)
- found (1+ found)))))
- (if (< found 3)
- (progn
- (setq b (make-marker)
- e (make-marker)
- egg-mark-list (cons (cons b e) egg-mark-list))
- (set-marker b beg)
- (set-marker e end))))))
-
-(defun egg-redraw-face ()
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (egg-suppress-marking t)
- (list egg-mark-list)
- (org-buffer (current-buffer))
- (org-point (point))
- mb me b e p)
- (setq egg-mark-list nil)
- (remove-hook 'post-command-hook 'egg-redraw-face)
- (while list
- (setq mb (car (car list))
- me (cdr (car list))
- list (cdr list))
- (when (marker-buffer mb)
- (set-buffer (marker-buffer mb))
- (let ((before-change-functions nil) (after-change-functions nil))
- (save-restriction
- (widen)
- (setq b (max mb (point-min))
- e (min me (point-max)))
- (set-marker mb nil)
- (set-marker me nil)
- (while (< b e)
- (if (null (get-text-property b 'egg-face))
- (setq b (next-single-property-change b 'egg-face nil e)))
- (setq p (next-single-property-change b 'egg-face nil e))
- (when (< b p)
- (goto-char b)
- (setq str (buffer-substring b p))
- (delete-region b p)
- (remove-text-properties 0 (- p b) '(face) str)
- (insert str)
- (setq b p)))))))
- (set-buffer org-buffer)
- (goto-char org-point)))
-\f
(defun egg-hinshi-select ()
(menudiag-select ; Should generate at initialization time
'(menu "\e$BIJ;lL>\e(B:"
(defgroup egg nil
"Tamagotchy --- EGG Versio 4.0")
+;;(load-library "its/hira")
+;;(setq-default its-current-map its-hira-map)
+
+;;(load-library "egg/wnn")
+;;(load-library "egg/wnnrpc")
+;;(setq egg-conversion-backend wnn-conversion-backend)
+
+;;(load-library "egg/sj3rpc")
+;;(load-library "egg/sj3")
+;;(setq egg-conversion-backend sj3-conversion-backend)
+
(defvar egg-support-languages nil)
(defun egg-set-support-languages (langs)
(make-variable-buffer-local 'its-zhuyin)
(put 'its-zhuyin 'permanent-local t)
-(eval-and-compile
+(eval-when (eval compile)
(defun its-make-select-func (key1 key2 func file map &optional zhuyin)
(setq func (intern (concat "its-select-" (symbol-name func)))
file (intern (concat "its/" (symbol-name file)))
(its-put-cursor t))
((egg-get-bunsetsu-info (point))
(egg-exit-conversion)))
- (setq its-current-select-func ',func
- its-current-map ',map)
- (if (its-get-language ,map)
- (setq its-current-language (its-get-language ,map)))
+ (setq its-current-select-func ',func)
+ (setq its-current-map ,map)
+ (if (its-get-language its-current-map)
+ (setq its-current-language (its-get-language its-current-map)))
,(if zhuyin `(setq its-zhuyin ,(eq zhuyin 'T)))
(if (null mode-line-unchange)
(its-set-mode-line-title)))))
- `(,func ,(concat "\C-x\C-m" key1) ,(concat "\e" key2)))))
+ `(define-key map
+ (if fence
+ ,(concat "\e" key2)
+ ,(concat "\C-x\C-m" key1))
+ ',func))))
(defmacro its-do-list-make-select-func (list)
- (let (funcs keydefs pair)
- (while list
- (setq pair (apply 'its-make-select-func (car list))
- funcs (cons (car pair) funcs)
- keydefs (cons (cdr pair) keydefs)
- list (cdr list)))
- `(progn
- ,@funcs
- (defvar its-define-select-key-list ',keydefs))))
-
-(defmacro its-add-select-funcs (list)
- (let (funcs keydefs pair)
- (while list
- (setq pair (apply 'its-make-select-func (car list))
- funcs (cons (car pair) funcs)
- keydefs (cons (cdr pair) keydefs)
- list (cdr list)))
- `(progn
- ,@funcs
- (setq its-define-select-key-list
- (append ',keydefs its-define-select-key-list)))))
-
-(defun its-define-select-keys (map &optional fence)
- (let ((key-list its-define-select-key-list))
- (while key-list
- (define-key map (nth 1 (car key-list)) (car (car key-list)))
- (if fence
- (define-key map (nth 2 (car key-list)) (car (car key-list))))
- (setq key-list (cdr key-list)))))
+ (eval-when (eval compile)
+ (let (funcs keydefs pair)
+ (while list
+ (setq pair (apply 'its-make-select-func (car list)))
+ (setq funcs (cons (car pair) funcs)
+ keydefs (cons (cdr pair) keydefs))
+ (setq list (cdr list)))
+ `(progn
+ ,@funcs
+ (defun its-define-select-keys (map &optional fence)
+ ,@keydefs)))))
(its-do-list-make-select-func
(("Q" "Q" upcase ascii up)
;;; Code:
(require 'cl)
-(require 'egg-edep)
(defvar its-current-map nil)
(make-variable-buffer-local 'its-current-map)
;;
;;
-(require 'its-keydef)
+(eval-when (eval load compile)
+ (require 'its-keydef))
(defvar its-mode-map
(let ((map (make-sparse-keymap))
(define-key map "\M-k" 'its-katakana)
(define-key map "\M-<" 'its-hankaku)
(define-key map "\M->" 'its-zenkaku)
+ (its-define-select-keys map t)
map)
"Keymap for ITS mode.")
-(fset 'its-mode-map its-mode-map)
-
(defvar its-fence-open "|" "*\e$B%U%'%s%9$N;OE@$r<($9J8;zNs\e(B (1 \e$BJ8;z0J>e\e(B)")
(defvar its-fence-close "|" "*\e$B%U%'%s%9$N=*E@$r<($9J8;zNs\e(B (1 \e$BJ8;z0J>e\e(B)")
(defvar its-fence-face nil "*\e$B%U%'%s%9I=<($KMQ$$$k\e(B face \e$B$^$?$O\e(B nil")
-(defvar its-fence-invisible nil)
(defconst its-setup-fence-before-insert-SYL nil)
(if face (cdr face) its-fence-face)))
(defun its-put-cursor (cursor)
- (let ((p (point)))
+ (let ((p (point))
+ (map (copy-keymap its-mode-map)))
+ (its-define-select-keys map)
(insert "!")
- (add-text-properties p (point) (list 'local-map 'its-mode-map
+ (add-text-properties p (point) (list 'local-map map
'read-only t
'invisible t
'intangible 'its-part-2
(let ((open-props '(its-start t intangible its-part-1))
(close-props '(rear-nonsticky t its-end t intangible its-part-2))
(p (point)) p1)
- ;; Put open-fence before inhibit-read-only to detect read-only
+ ;; Put open-fence before inhibit-read-only to detect read-nly
(insert its-fence-open)
(let ((inhibit-read-only t))
(setq p1 (point))
(add-text-properties p p1 open-props)
(insert its-fence-close)
(add-text-properties p1 (point) close-props)
- (if its-fence-invisible
+ (if its-fence-face
(put-text-property p (point) 'invisible t))
(put-text-property p (point) 'read-only t)
(goto-char p1)
- (its-define-select-keys its-mode-map t)
(its-put-cursor t))))
(defun its-start (key)
(its-input syl key)))
(defun its-initial-ISYL ()
- (its-get-start-state (symbol-value its-current-map)))
+ (its-get-start-state its-current-map))
(defun its-make-VSYL (keyseq)
(cons keyseq (length keyseq)))
'read-only t
'intangible 'its-part-1))
(if its-fence-face
- (egg-set-face p (point) (its-get-fence-face)))
+ (put-text-property p (point) 'face (its-get-fence-face)))
(its-set-cursor-status cursor))))
(defun its-buffer-delete-SYL (syl)
cursor)
(if (null syl)
(setq syl (its-initial-ISYL)))
- (if (numberp (cdr syl))
- nil
- (while (and syl (< i len))
- (setq cursor (its-state-machine syl (aref keyseq i) emit))
- (cond
- ((eq cursor 'its-keyseq-test-failed)
- (setq syl nil))
- (cursor
- (setq syl (its-initial-ISYL)))
- (t
- its-latest-SYL))
- (setq i (1+ i)))
- (if (and syl eol)
- (setq cursor (its-state-machine syl -1 emit)))
- (not (eq cursor 'its-keyseq-test-failed)))))
+ (while (and syl (< i len))
+ (setq cursor (its-state-machine syl (aref keyseq i) emit))
+ (cond
+ ((eq cursor 'its-keyseq-test-failed)
+ (setq syl nil))
+ (cursor
+ (setq syl (its-initial-ISYL)))
+ (t
+ its-latest-SYL))
+ (setq i (1+ i)))
+ (if (and syl eol)
+ (setq cursor (its-state-machine syl -1 emit)))
+ (not (eq cursor 'its-keyseq-test-failed))))
\f
;;;
;;; Name --> map
(defmacro define-its-state-machine (map name indicator lang doc &rest exprs)
`(progn
(eval-when (eval compile)
- (let ((its-current-map 'its-temporaly-map)
- (its-temporaly-map (its-new-map ,name ,indicator ,lang)))
+ (let ((its-current-map (its-new-map ,name ,indicator ,lang)))
,@exprs
- (setq ,map its-temporaly-map)))
+ (setq ,map its-current-map)))
(define-its-compiled-map ,map ,doc)))
(defmacro define-its-compiled-map (map doc)
(defmacro define-its-state-machine-append (map &rest exprs)
(append
- `(let ((its-current-map 'its-temporaly-map)
- (its-temporaly-map ,map)))
+ `(let ((its-current-map ,map)))
exprs
- (list `(setq ,map its-temporaly-map))))
+ (list `(setq ,map its-current-map))))
;;
;; Construct State Machine
(defun its-goto-state (input &optional initial-state build-if-none)
(let ((len (length input))
(i 0)
- (state (or initial-state
- (its-get-start-state (symbol-value its-current-map)))))
+ (state (or initial-state (its-get-start-state its-current-map))))
(while (< i len)
(setq state
(or (its-get-next-state state (aref input i))
t))
\f
;;;
-(defun its-set-part-1 (beg end)
- (let ((inhibit-point-motion-hooks t)
- (str (buffer-substring beg end)))
- (goto-char beg)
- (delete-region beg end)
- (put-text-property 0 (- end beg) 'intangible 'its-part-1 str)
- (insert str)))
-
-(defun its-set-part-2 (beg end)
- (let ((inhibit-point-motion-hooks t)
- (str (buffer-substring beg end)))
- (goto-char beg)
- (delete-region beg end)
- (put-text-property 0 (- end beg) 'intangible 'its-part-2 str)
- (insert str)))
-
(defun its-beginning-of-input-buffer ()
(interactive)
(let ((inhibit-read-only t))
(if (not (get-text-property (1- (point)) 'its-start))
(let ((begpos (previous-single-property-change (point) 'its-start)))
;; Make SYLs have property of "part 2"
- (its-set-part-2 begpos (point))
+ (put-text-property begpos (point) 'intangible 'its-part-2)
(goto-char begpos)))
(its-put-cursor t)))
(if (not (get-text-property (point) 'its-end))
(let ((endpos (next-single-property-change (point) 'its-end)))
;; Make SYLs have property of "part 1"
- (its-set-part-1 (point) endpos)
+ (put-text-property (point) endpos 'intangible 'its-part-1)
(goto-char endpos)))
(its-put-cursor t)))
(let ((inhibit-read-only t))
(delete-region (if (get-text-property (1- (point)) 'its-start)
(point)
- (previous-single-property-change (point) 'its-start))
+ (previous-single-property-change (1- (point)) 'its-start))
(if (get-text-property (point) 'its-end)
(point)
(next-single-property-change (point) 'its-end)))
(setq syl (get-text-property (1- p) 'its-syl))
(setq n (1- n)))
;; Make SYLs have property of "part 2"
- (its-set-part-2 p old-point)
+ (put-text-property p old-point 'intangible 'its-part-2)
(goto-char p)
(its-put-cursor t)
(if (> n 0)
(setq syl (get-text-property p 'its-syl))
(setq n (1- n)))
;; Make SYLs have property of "part 1"
- (its-set-part-1 old-point p)
+ (put-text-property old-point p 'intangible 'its-part-1)
(goto-char p)
(its-put-cursor t)
(if (> n 0)
;; TODO: killflag
(defun its-delete-backward-within-SYL (syl n killflag)
- (if (let* ((keyseq (its-get-keyseq-syl syl))
- (len (length keyseq))
- (p (- (point) (length (its-get-output syl))))
- (its-current-map (get-text-property (1- (point)) 'its-map))
- (its-current-language (get-text-property (1- (point)) 'egg-lang))
- back pp)
- (if (< n 0)
- (signal 'args-out-of-range (list (- (point) n) (point))))
- (if its-delete-by-keystroke
- (while (null (or (eq p pp) (its-concrete-DSYL-p syl)))
- (setq pp p)
- (while (and (setq syl (get-text-property (1- p) 'its-syl))
- (its-DSYL-with-back-p syl)
- (<= (setq back (- (its-get-kst/t syl))) len)
- (> back (- len n))
- (equal (substring (its-get-keyseq syl) (- back))
- (substring keyseq 0 back)))
- (setq keyseq (concat (its-get-keyseq-syl syl) keyseq)
- len (length keyseq)
- p (- p (length (its-get-output syl)))))
- (if (and (eq p pp) syl (> n len))
- (setq n (- n len)
- keyseq (its-get-keyseq-syl syl)
- len (length keyseq)
- p (- p (length (its-get-output syl))))))
- (if (and (> n len) (its-concrete-DSYL-p syl))
- (setq len 1)))
- (if (> n len)
- (setq n (- n len)
- len 0))
- (while (and (> n len) (setq syl (get-text-property (1- p) 'its-syl)))
- (setq n (1- n)
- p (- p (length (its-get-output syl)))))
- (if (> n len)
- (signal 'beginning-of-buffer nil))
- (delete-region p (point))
- (if (> len n)
- (its-state-machine-keyseq (substring keyseq 0 (- len n))
- 'its-buffer-ins/del-SYL)
- (its-set-cursor-status
- (if (or (null its-delete-by-keystroke)
- (its-concrete-DSYL-p (get-text-property (1- p) 'its-syl)))
- t
- 'its-cursor)))
- (and (get-text-property (1- (point)) 'its-start)
- (get-text-property (1+ (point)) 'its-end)))
- (its-exit-mode-internal)))
+ (let* ((keyseq (its-get-keyseq-syl syl))
+ (len (length keyseq))
+ (p (- (point) (length (its-get-output syl))))
+ (its-current-map (get-text-property (1- (point)) 'its-map))
+ (its-current-language (get-text-property (1- (point)) 'egg-lang))
+ back pp)
+ (if (< n 0)
+ (signal 'args-out-of-range (list (- (point) n) (point))))
+ (if its-delete-by-keystroke
+ (while (null (or (eq p pp) (its-concrete-DSYL-p syl)))
+ (setq pp p)
+ (while (and (setq syl (get-text-property (1- p) 'its-syl))
+ (its-DSYL-with-back-p syl)
+ (<= (setq back (- (its-get-kst/t syl))) len)
+ (> back (- len n))
+ (equal (substring (its-get-keyseq syl) (- back))
+ (substring keyseq 0 back)))
+ (setq keyseq (concat (its-get-keyseq-syl syl) keyseq)
+ len (length keyseq)
+ p (- p (length (its-get-output syl)))))
+ (if (and (eq p pp) syl (> n len))
+ (setq n (- n len)
+ keyseq (its-get-keyseq-syl syl)
+ len (length keyseq)
+ p (- p (length (its-get-output syl))))))
+ (if (and (> n len) (its-concrete-DSYL-p syl))
+ (setq len 1)))
+ (if (> n len)
+ (setq n (- n len)
+ len 0))
+ (while (and (> n len) (setq syl (get-text-property (1- p) 'its-syl)))
+ (setq n (1- n)
+ p (- p (length (its-get-output syl)))))
+ (if (> n len)
+ (signal 'beginning-of-buffer nil))
+ (delete-region p (point))
+ (cond
+ ((> len n)
+ (its-state-machine-keyseq (substring keyseq 0 (- len n))
+ 'its-buffer-ins/del-SYL))
+ ;; Check if empty
+ ((and (get-text-property (1- (point)) 'its-start)
+ (get-text-property (1+ (point)) 'its-end))
+ (its-exit-mode-internal))
+ ((and its-delete-by-keystroke
+ (null (its-concrete-DSYL-p (get-text-property (1- p) 'its-syl))))
+ (its-set-cursor-status 'its-cursor))
+ (t
+ (its-set-cursor-status t)))))
(defun its-transpose-chars (n)
(interactive "p")
(defun its-setup-yanked-portion (start end)
(let ((yank-before (eq (point) end))
- syl lang source no-prop-source len i j l)
- (setq source (buffer-substring start end)
- no-prop-source (buffer-substring-no-properties start end)
- len (length source))
- (remove-text-properties 0 len '(intangible nil) source)
- (egg-separate-languages source (get-text-property (1- start) 'egg-lang))
- (setq i 0)
- (while (< i len)
- (setq lang (get-text-property i 'egg-lang source))
+ (max-sisheng (make-char 'chinese-sisheng 127))
+ p syl lang)
+ (remove-text-properties start end '(intangible nil))
+ (egg-separate-languages start end t)
+ (goto-char start)
+ (while (< (point) end)
+ (setq p (point)
+ lang (get-text-property p 'egg-lang))
(if (and
- (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS))
- (setq l (egg-chinese-syllable source i)))
- (setq j (+ i l))
- (setq j (+ i (egg-char-bytes (egg-string-to-char-at source i)))))
- (setq syl (substring no-prop-source i j))
- (put-text-property i j 'its-syl (cons syl syl) source)
- (setq i j))
- (if its-fence-face
- (let (its-current-language)
- (setq i 0)
- (while (< i len)
- (setq j (egg-next-single-property-change i 'egg-lang source len)
- its-current-language (get-text-property i 'egg-lang source))
- (egg-set-face i j (its-get-fence-face) source)
- (setq i j))))
- (delete-region start end)
+ (or (equal lang "Chinese-GB") (equal lang "Chinese-CNS"))
+ (<= (following-char) max-sisheng)
+ (setq len (egg-chinese-syllable (buffer-substring (point) end))))
+ (goto-char (+ (point) len))
+ (forward-char))
+ (setq syl (buffer-substring-no-properties p (point)))
+ (put-text-property p (point) 'its-syl (cons syl syl))
+ (if its-fence-face
+ (let ((its-current-language (get-text-property p 'egg-lang)))
+ (put-text-property p (point) 'face (its-get-fence-face)))))
(if yank-before
- (progn
- (add-text-properties 0 len '(read-only t intangible its-part-1) source)
- (insert source))
+ (add-text-properties start end '(read-only t intangible its-part-1))
+ (add-text-properties start end '(read-only t intangible its-part-2))
(delete-region (point) (1+ (point)))
- (add-text-properties 0 len '(read-only t intangible its-part-2) source)
- (insert source)
(goto-char start)
(its-put-cursor t))))
(let ((cursor (get-text-property (point) 'its-cursor)))
;; key "END"
(if (null cursor)
- (let ((its-current-language (get-text-property (1- (point)) 'egg-lang)))
- (its-input (get-text-property (1- (point)) 'its-syl) -1)))
+ (its-input (get-text-property (1- (point)) 'its-syl) -1))
(delete-region (point) (1+ (point)))))
(defun its-exit-mode ()
(if proceed-to-conversion
(egg-convert-region start end)
;; Remove all properties
- (goto-char start)
- (setq s (buffer-substring-no-properties start end))
- (delete-region start end)
- (insert s)
+ (set-text-properties start end nil)
(egg-do-auto-fill)
(run-hooks 'input-method-after-insert-chunk-hook))))
(insert its-translation-result)))
\f
(defun its-set-mode-line-title ()
- (let ((title (its-get-indicator (symbol-value its-current-map))))
+ (let ((title (its-get-indicator its-current-map)))
(setq current-input-method-title (if its-previous-select-func
(concat "<" title ">")
title))
'its-select-hiragana)
(register-input-method
+ "japanese-egg-canna" "Japanese" 'egg-activate-canna
+ "" "Romaji -> Hiragana -> Kanji&Kana"
+ 'its-select-hiragana)
+
+(register-input-method
"chinese-gb-egg-wnn-py" "Chinese-GB" 'egg-activate-wnn
"" "Pinyin -> Simplified Hanzi"
'its-select-pinyin-cn)
(define-key map (char-to-string ch) 'undefined)
(setq ch (1+ ch)))
(setq ch ?0)
- (while (<= ch ?9)
+ (while (< ch ?9)
(define-key map (char-to-string ch) 'menudiag-goto-item)
(setq ch (1+ ch)))
(setq ch ?a)
- (while (<= ch ?z)
+ (while (< ch ?z)
(define-key map (char-to-string ch) 'menudiag-goto-item)
(setq ch (1+ ch)))
(setq ch ?A)
- (while (<= ch ?Z)
+ (while (< ch ?Z)
(define-key map (char-to-string ch) 'menudiag-goto-item)
(setq ch (1+ ch)))
(define-key map "\C-a" 'menudiag-beginning-of-line)
(defun menudiag-make-selection-list (item-list line-width)
(let ((l nil)
(line nil)
- (width 0)
- (i 0))
+ (width 0))
(while item-list
(let* ((item (car item-list))
(item-width (menudiag-item-width item)))
- (if (and line (or (>= (+ width item-width) line-width)
- (>= i 36)))
+ (if (and line (>= (+ width item-width) line-width))
(setq l (cons (reverse line) l)
line nil
- width 0
- i 0))
+ width 0))
(setq line (cons item line)
width (+ width (menudiag-item-width item))
- i (1+ i)
item-list (cdr item-list))))
(if line
(reverse (cons (reverse line) l))
(if (< pos-in-line (1- (length line)))
(menudiag-goto-item-internal (1+ pos-in-line))
(if (>= linepos (1- (length selection-list)))
- (menudiag-goto-line 0)
- (menudiag-goto-line (1+ linepos)))
- (menudiag-beginning-of-line)))
+ (signal 'end-of-buffer "")
+ (menudiag-goto-line (1+ linepos))
+ (menudiag-beginning-of-line))))
(defun menudiag-backward-item ()
(interactive)
(if (< 0 pos-in-line)
(menudiag-goto-item-internal (1- pos-in-line))
(if (< linepos 1)
- (menudiag-goto-line (1- (length selection-list)))
- (menudiag-goto-line (1- linepos)))
- (menudiag-end-of-line)))
+ (signal 'beginning-of-buffer "")
+ (menudiag-goto-line (1- linepos))
+ (menudiag-end-of-line))))
(defun menudiag-goto-line (n)
- (cond
- ((>= n (length selection-list))
- (setq n 0))
- ((< n 0)
- (setq n (1- (length selection-list)))))
- (setq line (nth n selection-list)
- linepos n)
- (delete-region (point-min) (point-max))
- (insert (menudiag-make-menu-formatted-string line)))
+ (if (or (>= n (length selection-list)) (< n 0))
+ (ding)
+ (setq line (nth n selection-list)
+ linepos n)
+ (delete-region (point-min) (point-max))
+ (insert (menudiag-make-menu-formatted-string line))))
(defun menudiag-next-line ()
(interactive)
projects / elisp / egg.git / commitdiff