* 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.

diff --git a/ChangeLog b/ChangeLog
index 0bc8724..1862f69 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,19 @@
 2001-07-09  Yoshiki Hayashi <yoshiki@xemacs.org>
 
+       * 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 <yoshiki@xemacs.org>
+
        * 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 (file)
--- 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)))
 
 \f
 (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)))