tamago-current.diff.gz in [tamago:00423] is applied.

[elisp/tamago.git] / egg-com.el

diff --git a/egg-com.el b/egg-com.el
index d36e5f6..6aaa58b 100644 (file)
--- a/egg-com.el
+++ b/egg-com.el
@@ -136,6 +136,7 @@
                    (cons ccl-decode-fixed-euc-kr ccl-encode-fixed-euc-kr))
 
 ;; Chinese
+
 (defconst egg-pinyin-shengmu
   '((""  . 0)  ("B" . 1)  ("C"  . 2)  ("Ch" . 3)  ("D" . 4)
     ("F" . 5)  ("G" . 6)  ("H"  . 7)  ("J"  . 8)  ("K" . 9)
@@ -521,53 +522,60 @@
 (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."
-  (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)
-           (cond
-            ((eq type 'cn)
-             (insert (charset-id 'chinese-gb2312) c0 (logior c1 ?\x80)))
-            ((>= c1 ?\x80)
-             (insert (charset-id 'chinese-cns11643-1) c0 c1))
-            (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 (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))))
+  (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)))
 
 (defun post-read-decode-fixed-euc-china (len type zhuyin)
   (let ((pos (point))
@@ -620,7 +628,7 @@ Return the length of resulting text."
 
 (eval-and-compile
 (define-ccl-program ccl-decode-egg-binary
-  `(2
+  `(1
     ((read r0)
      (loop
       (if (r0 == ?\xff)
@@ -628,7 +636,7 @@ Return the length of resulting text."
       (write-read-repeat r0)))))
 
 (define-ccl-program ccl-encode-egg-binary
-  `(1
+  `(2
     ((read r0)
      (loop
       (if (r0 == ?\xff)
@@ -705,6 +713,7 @@ U: 32-bit integer.  The argument is 2 element 16-bit unsigned integer list.
 u: 32-bit integer.  The argument is treat as unsigned integer.
    (Note:  Elisp's integer may be less than 32 bits)
 i: 32-bit integer.
+   (Note:  Elisp's integer may be greater than 32 bits)
 w: 16-bit integer.
 b: 8-bit integer.
 S: 16-bit wide-character EUC string (0x0000 terminated).
@@ -776,6 +785,14 @@ V: Fixed length string (0x00 terminated).  This takes 2 args (data length)."
          (+ (lsh (comm-following+forward-char) 8)
             (comm-following+forward-char)))))
 
+(defun comm-unpack-i32 ()
+  (progn
+    (comm-require-process-output 4)
+    (+ (lsh (- (logxor (comm-following+forward-char) 128) 128) 24)
+       (lsh (comm-following+forward-char) 16)
+       (lsh (comm-following+forward-char) 8)
+       (comm-following+forward-char))))
+
 (defun comm-unpack-u32 ()
   (progn
     (comm-require-process-output 4)
@@ -852,7 +869,7 @@ See `comm-format' for FORMAT."
             (list
              (cond ((eq f 'U) `(setq ,arg (comm-unpack-u32c)))
                    ((eq f 'u) `(setq ,arg (comm-unpack-u32)))
-                   ((eq f 'i) `(setq ,arg (comm-unpack-u32)))
+                   ((eq f 'i) `(setq ,arg (comm-unpack-i32)))
                    ((eq f 'w) `(setq ,arg (comm-unpack-u16)))
                    ((eq f 'b) `(setq ,arg (comm-unpack-u8)))
                    ((eq f 'S) `(setq ,arg (comm-unpack-u16-string)))