Problems of quoted printable decoder on Emacs 23.1

Kazuhiro Ito <[email protected]> Fri, 12 Mar 2010 22:56:49 +0900
Newsgroups gmane.mail.wanderlust.general.japanese,gmane.mail.emacs.mime.japanese
Message-ID <82vdd1tzha.wl%[email protected]>
--Multipart_Fri_Mar_12_22:56:49_2010-1
Content-Type: text/plain; charset=ISO-2022-JP

$B0KF#$G$9!#(B

  1. mel-q.el $B$N(B quoted printable $B$N%G%3!<%@!<$,(B Emacs 23.1 $B$G$O(B
  $B@5$7$/F0:n$7$J$$!#(B

(progn
  (require 'mel-q)
  (decode-coding-string
   (quoted-printable-decode-string
    (quoted-printable-encode-string
     (encode-coding-string "$B$"(B" 'utf-8)))
   'utf-8))

  $BEy$G3NG'$G$-$^$9!#(B

  2. Emacs 23.1 $B$O(B CCL coding system $B$N%G%3!<%@!<$@$1$G$J$/(B
  $B%(%s%3!<%@!<$b2u$l$F$$$k!#(B
  $B$3$N0Y!"(Bmel-q-ccl.el $B$N(B quoted printable $B$N%G%3!<%@!<$b(B
  $B@5$7$/F0:n$7$J$$!#(B

$B$H$$$&;v$K5$IU$-$^$7$?!#0l1~$NBP:v$r$7$?%Q%C%A$G$9!#(B
$BF0:n3NG'$O$"$^$j$7$F$$$^$;$s!#(B
$BFC$K(B XEmacs $B$OA4$/3NG'$7$F$$$^$;$s!#(B

-- 
$B0KF#(B $BOBGn(B(Kazuhiro Ito)

--Multipart_Fri_Mar_12_22:56:49_2010-1
Content-Type: application/octet-stream; type=patch
Content-Disposition: attachment; filename="flim.diff"
Content-Transfer-Encoding: 7bit

Index: ChangeLog
===================================================================
RCS file: /cvs/root/flim/ChangeLog,v
retrieving revision 1.136.2.147
diff -u -r1.136.2.147 ChangeLog
--- ChangeLog	18 Feb 2010 05:02:26 -0000	1.136.2.147
+++ ChangeLog	12 Mar 2010 12:54:13 -0000
@@ -1,3 +1,17 @@
+2010-03-10  Kazuhiro Ito  <[email protected]>
+
+	* mel-q-ccl.el (quoted-printable-ccl-decode-string)
+	(q-encoding-ccl-decode-string): Use ccl-execute-on-string() on
+	Emacs 23.1.
+	(quoted-printable-ccl-decode-region)
+	(quoted-printable-ccl-write-decoded-region): Use
+	quoted-printable-ccl-decode-string on Emacs 23.1.
+
+	* mel-q.el (quoted-printable-num-to-raw-byte-char): New inline
+	function.
+	(quoted-printable-internal-decode-region)
+	(q-encoding-decode-string): Use it.
+
 2010-02-18  Kazuhiro Ito  <[email protected]>
 
 	* mel-q-ccl.el (quoted-printable-ccl-encode-string)
Index: mel-q-ccl.el
===================================================================
RCS file: /cvs/root/flim/mel-q-ccl.el,v
retrieving revision 1.5.6.6
diff -u -r1.5.6.6 mel-q-ccl.el
--- mel-q-ccl.el	18 Feb 2010 05:02:26 -0000	1.5.6.6
+++ mel-q-ccl.el	12 Mar 2010 12:54:13 -0000
@@ -949,27 +949,56 @@
    'quoted-printable-ccl-insert-encoded-file)
   )
 
-(defun quoted-printable-ccl-decode-string (string)
-  "Decode quoted-printable encoded STRING."
-  (encode-coding-string
-   string
-   'mel-ccl-quoted-printable-lf-lf-rev))
+  (cond
+   ((eval-when-compile
+      (and (eq emacs-major-version 23)
+	   (eq emacs-minor-version 1)))
+    (defun quoted-printable-ccl-decode-string (string)
+      "Decode quoted-printable encoded STRING."
+      (ccl-execute-on-string 'mel-ccl-decode-quoted-printable-lf-lf
+			     (make-vector 9 0) string nil t))
+
+    (defun quoted-printable-ccl-decode-region (start end)
+      "Decode the region from START to END with quoted-printable
+encoding."
+      (interactive "*r")
+      (save-excursion
+	(goto-char start)
+	(insert (prog1 (quoted-printable-ccl-decode-string
+			(buffer-substring start end))
+		  (delete-region start end)))))
+
+    (defun quoted-printable-ccl-write-decoded-region (start end filename)
+      "Decode quoted-printable encoded current region and write out to FILENAME."
+      (interactive "*r\nFWrite decoded region to file: ")
+      (let ((string (quoted-printable-ccl-decode-string
+		     (buffer-substring start end)))
+	    (coding-system-for-write 'binary)
+	    jka-compr-compression-info-list jam-zcat-filename-list)
+	(with-temp-file filename
+	  (insert string)))))
+   (t
+    (defun quoted-printable-ccl-decode-string (string)
+      "Decode quoted-printable encoded STRING."
+      (encode-coding-string
+       string
+       'mel-ccl-quoted-printable-lf-lf-rev))
 
-(defun quoted-printable-ccl-decode-region (start end)
-  "Decode the region from START to END with quoted-printable
+    (defun quoted-printable-ccl-decode-region (start end)
+      "Decode the region from START to END with quoted-printable
 encoding."
-  (interactive "*r")
-  (encode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
+      (interactive "*r")
+      (encode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
 
-(defun quoted-printable-ccl-write-decoded-region (start end filename)
-  "Decode quoted-printable encoded current region and write out to FILENAME."
-  (interactive "*r\nFWrite decoded region to file: ")
-  (let ((coding-system-for-write
-	 (if (coding-system-p 'mel-ccl-quoted-printable-lf-lf-rev-unix)
-	     'mel-ccl-quoted-printable-lf-lf-rev-unix
-	   'mel-ccl-quoted-printable-lf-lf-rev))
-	jka-compr-compression-info-list jam-zcat-filename-list)
-    (write-region start end filename)))
+    (defun quoted-printable-ccl-write-decoded-region (start end filename)
+      "Decode quoted-printable encoded current region and write out to FILENAME."
+      (interactive "*r\nFWrite decoded region to file: ")
+      (let ((coding-system-for-write
+	     (if (coding-system-p 'mel-ccl-quoted-printable-lf-lf-rev-unix)
+		 'mel-ccl-quoted-printable-lf-lf-rev-unix
+	       'mel-ccl-quoted-printable-lf-lf-rev))
+	    jka-compr-compression-info-list jam-zcat-filename-list)
+	(write-region start end filename)))))
 
 (mel-define-method-function
  (mime-decode-string string (nil "quoted-printable"))
@@ -998,7 +1027,12 @@
 	((eq mode 'text) 'mel-ccl-encode-uq)
 	((eq mode 'comment) 'mel-ccl-encode-cq)
 	(t 'mel-ccl-encode-pq))
-       (make-vector 9 0) string nil t)))
+       (make-vector 9 0) string nil t))
+
+    (defun q-encoding-ccl-decode-string (string)
+      "Decode Q encoded STRING and return the result."
+      (ccl-execute-on-string 'mel-ccl-decode-q
+			     (make-vector 9 0) string nil t)))
    (t
     (defun q-encoding-ccl-encode-string (string &optional mode)
       "Encode STRING to Q-encoding of encoded-word, and return the result.
@@ -1009,13 +1043,13 @@
        (cond
 	((eq mode 'text) 'mel-ccl-uq-rev)
 	((eq mode 'comment) 'mel-ccl-cq-rev)
-	(t 'mel-ccl-pq-rev))))))
+	(t 'mel-ccl-pq-rev))))
 
-(defun q-encoding-ccl-decode-string (string)
-  "Decode Q encoded STRING and return the result."
-  (encode-coding-string
-   string
-   'mel-ccl-uq-rev))
+    (defun q-encoding-ccl-decode-string (string)
+      "Decode Q encoded STRING and return the result."
+      (encode-coding-string
+       string
+       'mel-ccl-uq-rev))))
 
 (unless (featurep 'xemacs)
   (defun q-encoding-ccl-encoded-length (string &optional mode)
Index: mel-q.el
===================================================================
RCS file: /cvs/root/flim/mel-q.el,v
retrieving revision 1.12.6.6
diff -u -r1.12.6.6 mel-q.el
--- mel-q.el	10 Feb 2010 04:17:43 -0000	1.12.6.6
+++ mel-q.el	12 Mar 2010 12:54:13 -0000
@@ -177,6 +177,18 @@
 	((<= ?0 chr) (- chr ?0))
 	))
 
+(if (eval-when-compile
+      (> (string-to-char (string-as-multibyte "\200")) 128))
+    (defsubst quoted-printable-num-to-raw-byte-char (chr)
+      (if (and chr
+	       (> chr 127))
+	  (logior chr
+		  (eval-when-compile
+		    (- (string-to-char (string-as-multibyte "\200")) 128)))
+	chr))
+  (defsubst quoted-printable-num-to-raw-byte-char (chr)
+    chr))
+
 (defun quoted-printable-internal-decode-region (start end)
   (save-excursion
     (save-restriction
@@ -198,9 +210,10 @@
 	  ;; encoded char.
 	  (insert
 	   (prog1
-	       (logior
-		(ash (quoted-printable-hex-char-to-num (char-after (point))) 4)
-		(quoted-printable-hex-char-to-num (char-after (1+ (point)))))
+	       (quoted-printable-num-to-raw-byte-char
+		(logior
+		 (ash (quoted-printable-hex-char-to-num (char-after (point))) 4)
+		 (quoted-printable-hex-char-to-num (char-after (1+ (point))))))
 	     (delete-region (1- (point))(+ 2 (point))))))
 	 (t
 	  ;; invalid encoding.
@@ -320,7 +333,9 @@
 			   "")
 			(h (setq l (quoted-printable-hex-char-to-num chr))
 			   (prog1
-			       (char-to-string (logior (ash h 4) l))
+			       (char-to-string
+				(quoted-printable-num-to-raw-byte-char
+				 (logior (ash h 4) l)))
 			     (setq h nil)))
 			(t (char-to-string chr)))))
 	       string "")))

--Multipart_Fri_Mar_12_22:56:49_2010-1--