head	1.2;
access;
symbols
	pkgsrc-2013Q2:1.2.0.10
	pkgsrc-2013Q2-base:1.2
	pkgsrc-2012Q4:1.2.0.8
	pkgsrc-2012Q4-base:1.2
	pkgsrc-2011Q4:1.2.0.6
	pkgsrc-2011Q4-base:1.2
	pkgsrc-2011Q2:1.2.0.4
	pkgsrc-2011Q2-base:1.2
	pkgsrc-2009Q4:1.2.0.2
	pkgsrc-2009Q4-base:1.2;
locks; strict;
comment	@# @;


1.2
date	2009.08.17.16.05.32;	author taca;	state dead;
branches;
next	1.1;

1.1
date	2009.08.17.15.28.23;	author taca;	state Exp;
branches;
next	;


desc
@@


1.2
log
@Revert previous.  It didn't work on emacs22.
@
text
@$NetBSD: patch-ab,v 1.1 2009/08/17 15:28:23 taca Exp $

--- egg-com.el.orig	2000-01-04 15:49:56.000000000 +0900
+++ egg-com.el
@@@@ -44,62 +44,101 @@@@
 
 ;; Japanese
 
-(eval-and-compile
-(define-ccl-program ccl-decode-fixed-euc-jp
-  `(2
-    ((r2 = ,(charset-id 'japanese-jisx0208))
-     (r3 = ,(charset-id 'japanese-jisx0212))
-     (r4 = ,(charset-id 'katakana-jisx0201))
-     (read r0)
-     (loop
-      (read r1)
-      (if (r0 < ?\x80)
-	  ((r0 = r1)
-	   (if (r1 < ?\x80)
-	       (write-read-repeat r0))
-	   (write r4)
-	   (write-read-repeat r0))
-	((if (r1 > ?\x80)
-	     ((write r2 r0)
-	      (r0 = r1)
-	      (write-read-repeat r0))
-	   ((write r3 r0)
-	    (r0 = (r1 | ?\x80))
-	    (write-read-repeat r0)))))))))
-
-(define-ccl-program ccl-encode-fixed-euc-jp
-  `(2
-    ((read r0)
-     (loop
-      (if (r0 == ,(charset-id 'latin-jisx0201))                   ; Unify
-	  ((read r0)
-	   (r0 &= ?\x7f)))
-      (if (r0 < ?\x80)                                            ;G0
-	  ((write 0)
-	   (write-read-repeat r0)))
-      (r6 = (r0 == ,(charset-id 'japanese-jisx0208)))
-      (r6 |= (r0 == ,(charset-id 'japanese-jisx0208-1978)))
-      (if r6                                                      ;G1
-	  ((read r0)
-	   (write r0)
-	   (read r0)
-	   (write-read-repeat r0)))
-      (if (r0 == ,(charset-id 'katakana-jisx0201))                ;G2
-	  ((read r0)
-	   (write 0)
-	   (write-read-repeat r0)))
-      (if (r0 == ,(charset-id 'japanese-jisx0212))                ;G3
-	  ((read r0)
-	   (write r0)
-	   (read r0)
-	   (r0 &= ?\x7f)
-	   (write-read-repeat r0)))
-      (read r0)
-      (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))
+(cond
+ ((string-match "^\\(20\\|21\\|22\\)" emacs-version)
+  (eval-and-compile
+    (define-ccl-program ccl-decode-fixed-euc-kr
+      `(2
+	((r2 = ,(charset-id 'korean-ksc5601))
+	 (read r0)
+	 (loop
+	  (read r1)
+	  (if (r0 < ?\x80)
+	      (r0 = r1 & ?\x7f)
+	    ((write r2 r0)
+	     (r0 = r1 | ?\x80)))
+	  (write-read-repeat r0)))))
+
+    (define-ccl-program ccl-encode-fixed-euc-kr
+      `(2
+	((read r0)
+	 (loop
+	  (if (r0 < ?\x80)
+	      ((write 0)
+	       (write-read-repeat r0)))
+	  (if (r0 == ,(charset-id 'korean-ksc5601))
+	      ((read r0)
+	       (write r0)
+	       (read r0)
+	       (write-read-repeat r0)))
+	  (read r0)
+	  (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)))
+ (t
+  (defun fixed-euc-jp-pre-write-conversion (from to)
+    (let ((work-buf (generate-new-buffer " *temp*"))
+	  ch)
+      (if (stringp from)
+	  (encode-coding-string from 'euc-japan nil work-buf)
+	(encode-coding-region from to 'euc-japan work-buf))
+      (set-buffer work-buf)
+      (set-buffer-multibyte nil)
+      (goto-char (point-min))
+      (while (not (eobp))
+	(setq ch (following-char))
+	(cond ((= ch #x8E)		; SS2 for JISX0201-kana
+	       (delete-char 1)		; SS2 BYTE -> 0 BYTE&0x7F
+	       (insert 0)
+	       (forward-char 1))
+	      ((= ch #x8F)		; SS3 for JISX0212
+	       (delete-char 1)		; SS3 BYTE1 BYTE2 -> BYTE1 BYTE2&0x7F
+	       (forward-char 1)
+	       (setq ch (following-char))
+	       (delete-char 1)
+	       (insert (logand ch #x7F)))
+	      ((>= ch #xA0)		; JISX0208
+	       (forward-char 2))
+	      (t			; ASCII
+	       (insert 0)		; BYTE -> 0 BYTE
+	       (forward-char 1))))))
+
+  (defun fixed-euc-jp-post-read-conversion (len)
+    (let ((str (string-as-unibyte (buffer-substring (point) (+ (point) len))))
+	  (pos (point))
+	  i ch1 ch2)
+      (delete-region (point) (+ (point) len))
+      (setq i 0)
+      (while (< i len)
+	(setq ch1 (aref str i))
+	(setq ch2 (aref str (1+ i)))
+	(cond ((>= ch1 #x80)
+	       (if (>= ch2 #x80)
+		   (setq ch1 		; JISX0208
+			 (decode-char 'japanese-jisx0208
+				      (logior (lsh (logand ch1 #x7F) 8)
+					      (logand ch2 #x7F))))
+		 (setq ch1		; JISX0212
+		       (decode-char 'japanese-jisx0212
+				    (logior (lsh (logand ch1 #x7F) 8) ch2)))))
+	      (t
+	       (if (>= ch2 #x80)
+		   (setq ch1		; JISX0201-kana
+			 (decode-char 'katakana-jisx0201 (logand ch2 #x7F)))
+		 (setq ch1 ch2))))
+	(insert ch1)
+	(setq i (+ i 2)))
+      (prog1 (- (point) pos)
+	(goto-char pos))))
+
+  (define-coding-system 'fixed-euc-jp "Coding System for fixed EUC Japanese"
+    :mnemonic ?W
+    :coding-type 'raw-text
+    :charset-list '(ascii japanese-jisx0208 katakana-jisx0201 japanese-jisx0212)
+    :pre-write-conversion 'fixed-euc-jp-pre-write-conversion
+    :post-read-conversion 'fixed-euc-jp-post-read-conversion)))
 
 ;; Korean
 
@@@@ -136,6 +175,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 +561,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 +667,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 +675,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 +752,7 @@@@ U: 32-bit integer.  The argument is 2 el
 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 +824,14 @@@@ V: Fixed length string (0x00 terminated)
 	  (+ (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 +908,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)))
@


1.1
log
@To work on emacs23, add a minimum patch from
http://www.m17n.org/mlarchive/mule-ja/200703/msg00018.html.

Bump PKGREVISION.
@
text
@d1 1
a1 1
$NetBSD$
@