From d647bc38ce156d64973e86a63488d4feb053c672 Mon Sep 17 00:00:00 2001 From: hayashi Date: Mon, 9 Jul 2001 06:48:59 +0000 Subject: [PATCH] * egg-com.el (ccl-decode-fixed-euc-jp): Make it XEmacs compatible. (ccl-decode-fixed-euc-kr): Ditto. (decode-fixed-euc-china-region): Check against the charset sisheng which is an XEmacs version of chinese-sisheng. Use make-char instead of writing internal byte-sequence directly. (comm-format-u16-string): Work around the problem that XEmacs does not call pre-write-conversion when encode-coding-string is called. (comm-unpack-u16-string): Work around the problem that XEmacs does not call post-read-conversion when decode-coding-string is called. * egg-com.el: Add call to XEmacs version of make-coding-system. --- ChangeLog | 14 +++ egg-com.el | 288 ++++++++++++++++++++++++++++++++++++++---------------------- 2 files changed, 197 insertions(+), 105 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0bc8724..1862f69 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,19 @@ 2001-07-09 Yoshiki Hayashi + * egg-com.el (ccl-decode-fixed-euc-jp): Make it XEmacs compatible. + (ccl-decode-fixed-euc-kr): Ditto. + (decode-fixed-euc-china-region): Check against the charset sisheng + which is an XEmacs version of chinese-sisheng. + Use make-char instead of writing internal byte-sequence directly. + (comm-format-u16-string): Work around the problem that XEmacs does + not call pre-write-conversion when encode-coding-string is called. + (comm-unpack-u16-string): Work around the problem that XEmacs does + not call post-read-conversion when decode-coding-string is called. + + * egg-com.el: Add call to XEmacs version of make-coding-system. + +2001-07-09 Yoshiki Hayashi + * its.el (its-get-keyseq-syl): Use egg-characterp instead of numberp. diff --git a/egg-com.el b/egg-com.el index 6aaa58b..eb4fc9e 100644 --- a/egg-com.el +++ b/egg-com.el @@ -57,15 +57,22 @@ ((r0 = r1) (if (r1 < ?\x80) (write-read-repeat r0)) - (write r4) - (write-read-repeat r0)) + (write-multibyte-character r4 r0) + (read r0) + (repeat)) ((if (r1 > ?\x80) - ((write r2 r0) - (r0 = r1) - (write-read-repeat r0)) - ((write r3 r0) - (r0 = (r1 | ?\x80)) - (write-read-repeat r0))))))))) + ((r0 &= ?\x7f) + (r0 <<= 7) + (r0 |= (r1 & ?\x7f)) + (write-multibyte-character r2 r0) + (read r0) + (repeat)) + ((r0 &= ?\x7f) + (r0 <<= 7) + (r0 |= r1) + (write-multibyte-character r3 r0) + (read r0) + (repeat))))))))) (define-ccl-program ccl-encode-fixed-euc-jp `(2 @@ -98,8 +105,13 @@ (repeat))))) ) -(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)) +(if (featurep 'xemacs) + (make-coding-system 'fixed-euc-jp 'ccl "Coding System for fixed EUC Japanese" + '(mnemonic "W" + decode ccl-decode-fixed-euc-jp + encode ccl-encode-fixed-euc-jp)) + (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))) ;; Korean @@ -111,10 +123,14 @@ (loop (read r1) (if (r0 < ?\x80) - (r0 = r1 & ?\x7f) - ((write r2 r0) - (r0 = r1 | ?\x80))) - (write-read-repeat r0))))) + ((r0 = r1 & ?\x7f) + (write-read-repeat r0)) + ((r0 &= ?\x7f) + (r0 <<= 7) + (r0 |= (r1 & ?\x7f)) + (write-multibyte-character r2 r0) + (read r0) + (repeat))))))) (define-ccl-program ccl-encode-fixed-euc-kr `(2 @@ -132,11 +148,15 @@ (repeat))))) ) -(make-coding-system 'fixed-euc-kr 4 ?W "Coding System for fixed EUC Korean" - (cons ccl-decode-fixed-euc-kr ccl-encode-fixed-euc-kr)) +(if (featurep 'xemacs) + (make-coding-system 'fixed-euc-kr 'ccl "Coding System for fixed EUC Korean" + '(mnemonic "W" decode ccl-decode-fixed-euc-kr + encode ccl-encode-fixed-euc-kr)) + (make-coding-system 'fixed-euc-kr 4 ?W "Coding System for fixed EUC Korean" + (cons ccl-decode-fixed-euc-kr ccl-encode-fixed-euc-kr))) -;; Chinese +;; Chinese (defconst egg-pinyin-shengmu '(("" . 0) ("B" . 1) ("C" . 2) ("Ch" . 3) ("D" . 4) ("F" . 5) ("G" . 6) ("H" . 7) ("J" . 8) ("K" . 9) @@ -493,6 +513,9 @@ ((eq cset 'chinese-sisheng) (delete-char 1) (insert 0 (+ (nth 1 c) 128))) + ((eq cset 'sisheng) + (delete-char 1) + (insert 0 (+ (nth 1 c) 128))) ((eq cset 'ascii) (delete-char 1) (insert 0 (nth 1 c))) @@ -522,60 +545,58 @@ (defun decode-fixed-euc-china-region (beg end type zhuyin) "Decode EUC-CN/TW encoded text in the region. Return the length of resulting text." - (let ((str (string-as-unibyte (buffer-substring beg end))) - (i 0) - (char (make-string 3 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 c1) - (aset char 0 leading-code-private-11) - (aset char 1 (charset-id 'chinese-sisheng)) - (aset char 2 c1) - (insert (string-as-multibyte char)))) - ((>= c0 ?\x80) - (cond - ((eq type 'cn) - (aset char 0 (charset-id 'chinese-gb2312)) - (aset char 1 c0) - (aset char 2 (logior c1 ?\x80))) - ((>= c1 ?\x80) - (aset char 0 (charset-id 'chinese-cns11643-1)) - (aset char 1 c0) - (aset char 2 c1)) - (t - (aset char 0 (charset-id 'chinese-cns11643-2)) - (aset char 1 c0) - (aset char 2 (+ c1 ?\x80)))) - (insert (string-as-multibyte char))) - (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 (and (eq s 20) - (eq (aref egg-pinyin-table (+ (* 39 20) y)) 0)) - (setq s 0)) - (if (null zhuyin) - (setq s (car (nth s egg-pinyin-shengmu)) - y (car (nth (+ (* 5 y) ss) egg-pinyin-yunmu))) - (setq c0 (aref egg-zhuyin-table (+ (* 41 s) y))) - (if (eq (logand c0 ?\x8080) ?\x80) - (setq s (lsh c0 -8) - y (logand c0 ?\x7f))) - (setq s (car (nth s egg-zhuyin-shengmu)) - y (car (nth (+ (* 5 y) ss) egg-zhuyin-yunmu)))) - (if enable-multibyte-characters - (insert s y) - (insert (string-as-unibyte s) (string-as-unibyte y)))))) - (- (point) beg))) + (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 (if (featurep 'xemacs) + (char-to-int (aref str i)) + (aref str i)) + c1 (if (featurep 'xemacs) + (char-to-int (aref str (1+ i))) + (aref str (1+ i))) + i (+ i 2)) + (cond + ((eq c0 0) + (if (> c1 ?\xa0) + (insert (make-char (if (featurep 'xemacs) + 'sisheng + 'chinese-sisheng) + c1)) + (insert c1))) + ((>= c0 ?\x80) + (cond + ((eq type 'cn) + (insert (make-char 'chinese-gb2312 c0 c1))) + ((>= c1 ?\x80) + (insert (make-char 'chinese-cns11643-1 c0 c1))) + (t + (insert (make-char 'chinese-cns11643-2 c0 c1))))) + (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 (and (eq s 20) + (eq (aref egg-pinyin-table (+ (* 39 20) y)) 0)) + (setq s 0)) + (if (null zhuyin) + (setq s (car (nth s egg-pinyin-shengmu)) + y (car (nth (+ (* 5 y) ss) egg-pinyin-yunmu))) + (setq c0 (aref egg-zhuyin-table (+ (* 41 s) y))) + (if (eq (logand c0 ?\x8080) ?\x80) + (setq s (lsh c0 -8) + y (logand c0 ?\x7f))) + (setq s (car (nth s egg-zhuyin-shengmu)) + y (car (nth (+ (* 5 y) ss) egg-zhuyin-yunmu)))) + (if enable-multibyte-characters + (insert s y) + (insert (string-as-unibyte s) (string-as-unibyte y)))))) + (- (point) beg)) + (if (looking-at "\0\0") (forward-char 2)))) (defun post-read-decode-fixed-euc-china (len type zhuyin) (let ((pos (point)) @@ -596,34 +617,70 @@ Return the length of resulting text." (defun post-read-decode-euc-zy-tw (len) (post-read-decode-fixed-euc-china len 'tw t)) -(make-coding-system 'fixed-euc-py-cn 0 ?W - "Coding System for fixed EUC Chinese-gb2312") -(coding-system-put 'fixed-euc-py-cn - 'pre-write-conversion 'pre-write-encode-euc-cn) -(coding-system-put 'fixed-euc-py-cn - 'post-read-conversion 'post-read-decode-euc-py-cn) - -(make-coding-system 'fixed-euc-zy-cn 0 ?W - "Coding System for fixed EUC Chinese-gb2312") -(coding-system-put 'fixed-euc-zy-cn - 'pre-write-conversion 'pre-write-encode-euc-cn) -(coding-system-put 'fixed-euc-zy-cn - 'post-read-conversion 'post-read-decode-euc-zy-cn) - -(make-coding-system 'fixed-euc-py-tw 0 ?W - "Coding System for fixed EUC Chinese-cns11643") -(coding-system-put 'fixed-euc-py-tw - 'pre-write-conversion 'pre-write-encode-euc-tw) -(coding-system-put 'fixed-euc-py-tw - 'post-read-conversion 'post-read-decode-euc-py-tw) - -(make-coding-system 'fixed-euc-zy-tw 0 ?W - "Coding System for fixed EUC Chinese-cns11643") -(coding-system-put 'fixed-euc-zy-tw - 'pre-write-conversion 'pre-write-encode-euc-tw) -(coding-system-put 'fixed-euc-zy-tw - 'post-read-conversion 'post-read-decode-euc-zy-tw) - +;; XEmacs incompatibility note. + +;; XEmacs uses pre-write-conversion and post-read-conversion when +;; characters are read from or written to files. post-read-conversion +;; functions are called with arguments start and end. It is not +;; compatible with Emacs' counterpart which is called with length. +;; This coding-system does not work on XEmacs because +;; post-read-conversion is written in Emacs style. + +;; The actual usage of this coding-system is to convert string to the +;; format cserver expects. The problem is that post-read-conversion +;; and pre-write-conversion is ignored when decode-coding-string and +;; encode-coding-string are called, not post-read-conversion is +;; incompatible. So I decided to leave post-read-conversion as is and +;; call it from comm-format-u16-string and comm-unpack-u16-string to +;; work around the problem. +(if (featurep 'xemacs) + (make-coding-system 'fixed-euc-py-cn 'no-conversion + "Coding System for fixed EUC Chinese-gb2312" + '(mnemonic "W" pre-write-conversion pre-write-encode-euc-cn + post-read-conversion post-read-decode-euc-py-cn)) + (make-coding-system 'fixed-euc-py-cn 0 ?W + "Coding System for fixed EUC Chinese-gb2312") + (coding-system-put 'fixed-euc-py-cn + 'pre-write-conversion 'pre-write-encode-euc-cn) + (coding-system-put 'fixed-euc-py-cn + 'post-read-conversion 'post-read-decode-euc-py-cn)) + +(if (featurep 'xemacs) + (make-coding-system 'fixed-euc-zy-cn 'no-conversion + "Coding System for fixed EUC Chinese-gb2312" + '(mnemonic "W" pre-write-conversion pre-write-encode-euc-cn + post-read-conversion post-read-decode-euc-zy-cn)) + (make-coding-system 'fixed-euc-zy-cn 0 ?W + "Coding System for fixed EUC Chinese-gb2312") + (coding-system-put 'fixed-euc-zy-cn + 'pre-write-conversion 'pre-write-encode-euc-cn) + (coding-system-put 'fixed-euc-zy-cn + 'post-read-conversion 'post-read-decode-euc-zy-cn)) + +(if (featurep 'xemacs) + (make-coding-system 'fixed-euc-py-tw 'no-conversion + "Coding System for fixed EUC Chinese-gb2312" + '(mnemonic "W" pre-write-conversion pre-write-encode-euc-tw + post-read-conversion post-read-decode-euc-py-tw)) + (make-coding-system 'fixed-euc-py-tw 0 ?W + "Coding System for fixed EUC Chinese-cns11643") + (coding-system-put 'fixed-euc-py-tw + 'pre-write-conversion 'pre-write-encode-euc-tw) + (coding-system-put 'fixed-euc-py-tw + 'post-read-conversion 'post-read-decode-euc-py-tw)) + +(if (featurep 'xemacs) + (make-coding-system 'fixed-euc-zy-tw 'no-conversion + "Coding System for fixed EUC Chinese-gb2312" + '(mnemonic "W" pre-write-conversion pre-write-encode-euc-tw + post-read-conversion post-read-decode-euc-zy-tw)) + (make-coding-system 'fixed-euc-zy-tw 0 ?W + "Coding System for fixed EUC Chinese-cns11643") + (coding-system-put 'fixed-euc-zy-tw + 'pre-write-conversion 'pre-write-encode-euc-tw) + (coding-system-put 'fixed-euc-zy-tw + 'post-read-conversion 'post-read-decode-euc-zy-tw) + ) ;; Binary data (eval-and-compile @@ -644,8 +701,10 @@ Return the length of resulting text." (r0 = 0))) (write-read-repeat r0)))))) -(make-coding-system 'egg-binary 4 ?W "Coding System for binary data" - (cons ccl-decode-egg-binary ccl-encode-egg-binary)) +(if (featurep 'xemacs) + (define-coding-system-alias 'egg-binary 'binary) + (make-coding-system 'egg-binary 4 ?W "Coding System for binary data" + (cons ccl-decode-egg-binary ccl-encode-egg-binary))) (defun comm-format-u32c (uint32c) @@ -679,8 +738,17 @@ Return the length of resulting text." s)) (defun comm-format-u16-string (s) - (insert (encode-coding-string (comm-format-truncate-after-null s) - egg-fixed-euc)) + (if (and (featurep 'xemacs) + (coding-system-get egg-fixed-euc 'pre-write-conversion)) + (let ((fixed-euc egg-fixed-euc)) + (insert (with-temp-buffer + (insert (comm-format-truncate-after-null s)) + (goto-char (point-min)) + (funcall (coding-system-get fixed-euc 'pre-write-conversion) + (point-min) (point-max)) + (buffer-string)))) + (insert (encode-coding-string (comm-format-truncate-after-null s) + egg-fixed-euc))) (insert-char 0 2)) (defun comm-format-mb-string (s) @@ -816,8 +884,18 @@ V: Fixed length string (0x00 terminated). This takes 2 args (data length)." (let ((start (point))) (while (not (search-forward "\0\0" nil t)) (comm-accept-process-output)) - (decode-coding-string (buffer-substring start (- (point) 2)) - egg-fixed-euc))) + (if (and (featurep 'xemacs) + (coding-system-get egg-fixed-euc 'post-read-conversion)) + (let ((string (buffer-substring start (- (point) 2))) + (fixed-euc egg-fixed-euc)) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (funcall (coding-system-get fixed-euc 'post-read-conversion) + (1- (point-max))) + (buffer-string))) + (decode-coding-string (buffer-substring start (- (point) 2)) + egg-fixed-euc)))) (defun comm-unpack-mb-string () (let ((start (point))) -- 1.7.10.4