From: morioka Date: Sun, 30 Aug 1998 10:31:46 +0000 (+0000) Subject: Merge egg-980316. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=28fb101186f07642d2a7e203dca11c9256b9868a;p=elisp%2Fegg.git Merge egg-980316. --- diff --git a/egg-cnv.el b/egg-cnv.el index 6045eb2..f9df95d 100644 --- a/egg-cnv.el +++ b/egg-cnv.el @@ -9,7 +9,7 @@ ;; Maintainer: NIIBE Yutaka ;; 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 @@ -31,33 +31,31 @@ ;;; 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 @@ -69,7 +67,6 @@ ) (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) @@ -105,7 +102,7 @@ (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))) @@ -168,173 +165,165 @@ (defvar egg-conversion-open "|" "*$B%U%'%s%9$N;OE@$r<($9J8;zNs(B (1 $BJ8;z0J>e(B)") (defvar egg-conversion-close "|" "*$B%U%'%s%9$N=*E@$r<($9J8;zNs(B (1 $BJ8;z0J>e(B)") (defvar egg-conversion-face nil "*$B%U%'%s%9I=<($KMQ$$$k(B face $B$^$?$O(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")))) +(require 'its-keydef) + (defvar egg-conversion-map (let ((map (make-sparse-keymap)) (i 33)) @@ -363,45 +352,39 @@ (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") @@ -448,13 +431,13 @@ (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)) @@ -503,10 +486,6 @@ (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) @@ -524,21 +503,17 @@ Otherwise stop at the last candidate.") (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)))) @@ -581,65 +556,108 @@ Otherwise stop at the last candidate.") (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) @@ -673,7 +691,7 @@ Otherwise stop at the last candidate.") (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) diff --git a/egg-com.el b/egg-com.el index 1a26c8f..a45871f 100644 --- a/egg-com.el +++ b/egg-com.el @@ -10,7 +10,7 @@ ;; KATAYAMA Yoshio ; Korean, Chinese support. ;; Maintainer: NIIBE Yutaka -;; 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 @@ -31,8 +31,6 @@ ;;; Code: -(require 'egg-edep) - (defvar egg-fixed-euc 'fixed-euc-jp) (make-variable-buffer-local 'egg-fixed-euc) @@ -62,24 +60,30 @@ (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))) @@ -94,7 +98,7 @@ ) (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 @@ -115,13 +119,17 @@ `(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))))) @@ -408,23 +416,20 @@ ?\x0000 ]) -(defconst egg-chinese-syllable-max-len - (max (length "Zhu(0!(Bng(0@(B") (length "(0ShdA(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(0!(B-(0?(B]+(0@(B" str) 0) + (if (string-match "^[A-Za-z(0!(B-(0?(B]+(0@(B" str) (progn (setq end (match-end 0)) (cond @@ -439,8 +444,8 @@ (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 "^[(0E(B-(0i(B@0-4]+[(0@ABCD(B]" str) 0) + (let (end s y c z (zhuyin-len (charset-bytes 'chinese-sisheng))) + (if (string-match "^[(0E(B-(0i(B@0-4]+[(0@ABCD(B]" str) (progn (setq end (match-end 0) c (substring str 0 zhuyin-len) @@ -460,22 +465,21 @@ (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(0!(Bng(0@(B") (length "(0ShdA(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)) @@ -490,11 +494,9 @@ ((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) @@ -502,11 +504,9 @@ (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)) @@ -519,56 +519,54 @@ (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) @@ -584,13 +582,13 @@ Return the length of resulting text." (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) (defsubst comm-format-u32c (uint32c) (let ((h0 (car uint32c)) @@ -746,22 +744,20 @@ v means 8-bit vector." (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))) diff --git a/egg-mlh.el b/egg-mlh.el index 1c9aefe..a520acf 100644 --- a/egg-mlh.el +++ b/egg-mlh.el @@ -10,7 +10,7 @@ ;; Maintainer: NIIBE Yutaka ;; 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 @@ -33,8 +33,6 @@ ;;; 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. @@ -43,12 +41,7 @@ Or else, execute command that space-bar invokes usually." (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))) diff --git a/egg.el b/egg.el index 601c981..a88bcf2 100644 --- a/egg.el +++ b/egg.el @@ -9,7 +9,7 @@ ;; Maintainer: NIIBE Yutaka ;; 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 @@ -29,12 +29,10 @@ ;;; 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) @@ -55,7 +53,6 @@ (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)) @@ -69,8 +66,7 @@ (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." @@ -96,96 +92,6 @@ (interactive) (its-start last-command-char)) -(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))) - (defun egg-hinshi-select () (menudiag-select ; Should generate at initialization time '(menu "$BIJ;lL>(B:" @@ -257,6 +163,17 @@ (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) diff --git a/its-keydef.el b/its-keydef.el index 5e3a835..9372491 100644 --- a/its-keydef.el +++ b/its-keydef.el @@ -5,7 +5,7 @@ (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))) @@ -23,45 +23,31 @@ (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) diff --git a/its.el b/its.el index 513e392..89c5bd2 100644 --- a/its.el +++ b/its.el @@ -31,7 +31,6 @@ ;;; Code: (require 'cl) -(require 'egg-edep) (defvar its-current-map nil) (make-variable-buffer-local 'its-current-map) @@ -188,7 +187,8 @@ ;; ;; -(require 'its-keydef) +(eval-when (eval load compile) + (require 'its-keydef)) (defvar its-mode-map (let ((map (make-sparse-keymap)) @@ -228,15 +228,13 @@ (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 "|" "*$B%U%'%s%9$N;OE@$r<($9J8;zNs(B (1 $BJ8;z0J>e(B)") (defvar its-fence-close "|" "*$B%U%'%s%9$N=*E@$r<($9J8;zNs(B (1 $BJ8;z0J>e(B)") (defvar its-fence-face nil "*$B%U%'%s%9I=<($KMQ$$$k(B face $B$^$?$O(B nil") -(defvar its-fence-invisible nil) (defconst its-setup-fence-before-insert-SYL nil) @@ -247,9 +245,11 @@ (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 @@ -275,18 +275,17 @@ (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) @@ -319,7 +318,7 @@ (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))) @@ -471,7 +470,7 @@ '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) @@ -517,21 +516,19 @@ 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)))) ;;; ;;; Name --> map @@ -554,10 +551,9 @@ (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) @@ -565,10 +561,9 @@ (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 @@ -588,8 +583,7 @@ Return last state." (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)) @@ -644,22 +638,6 @@ Return last state." t)) ;;; -(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)) @@ -667,7 +645,7 @@ Return last state." (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))) @@ -678,7 +656,7 @@ Return last state." (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))) @@ -712,7 +690,7 @@ Return last state." (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))) @@ -733,7 +711,7 @@ Return last state." (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) @@ -753,7 +731,7 @@ Return last state." (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) @@ -821,53 +799,55 @@ Return last state." ;; 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") @@ -938,39 +918,29 @@ Return last state." (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)))) @@ -979,8 +949,7 @@ Return last state." (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 () @@ -1012,10 +981,7 @@ Return last state." (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)))) @@ -1079,7 +1045,7 @@ Return last state." (insert its-translation-result))) (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)) diff --git a/leim-list-egg.el b/leim-list-egg.el index 215b9a0..e1e944f 100644 --- a/leim-list-egg.el +++ b/leim-list-egg.el @@ -14,6 +14,11 @@ '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) diff --git a/menudiag.el b/menudiag.el index 8829ad5..a8a57de 100644 --- a/menudiag.el +++ b/menudiag.el @@ -59,15 +59,15 @@ (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) @@ -110,20 +110,16 @@ (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)) @@ -257,29 +253,26 @@ (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)