From: akr <akr>
Date: Mon, 24 Aug 1998 13:26:10 +0000 (+0000)
Subject: * ew-bq.el (ew-ccl-decode-quoted-printable): New CCL program.
X-Git-Tag: doodle-1_9_2~22
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=4a15ad0838f7f2ab125b4f766b127aefc828580c;p=elisp%2Fflim.git

* ew-bq.el (ew-ccl-decode-quoted-printable): New CCL program.
(ew-ccl-quoted-printable): New coding-system.
---

diff --git a/ChangeLog b/ChangeLog
index b884bde..fa624eb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
 1998-08-24  Tanaka Akira      <akr@jaist.ac.jp>
 
+	* ew-bq.el (ew-ccl-decode-quoted-printable): New CCL program.
+	(ew-ccl-quoted-printable): New coding-system.
+
+1998-08-24  Tanaka Akira      <akr@jaist.ac.jp>
+
 	* DOODLE-TIPS: Add a notice about ew-ccl-b.
 
 	* ew-bq.el (ew-bq-use-mel): New variable.
diff --git a/ew-bq.el b/ew-bq.el
index 07a2f16..82b3f97 100644
--- a/ew-bq.el
+++ b/ew-bq.el
@@ -640,6 +640,109 @@
 	))
       )))
 
+(define-ccl-program ew-ccl-decode-quoted-printable
+  (eval-when-compile
+    `(1
+      ((read r0)
+       (loop
+	(branch
+	 r0
+	 ,@(mapcar
+	    (lambda (r0)
+	      (let ((tmp (aref ew-ccl-qp-table r0)))
+		(cond
+		 ((or (eq tmp 'raw) (eq tmp 'wsp)) `(write-read-repeat r0))
+		 ((eq r0 ?=)
+		  ;; r0='='
+		  `((read r0)
+		    ;; '=' r0
+		    (r1 = (r0 == ?\t))
+		    (if ((r0 == ? ) | r1)
+			;; '=' r0:[\t ]
+			;; Skip transport-padding.
+			;; It should check CR LF after
+			;; transport-padding.
+			(loop
+			 (read-if (r0 == ?\t)
+				  (repeat)
+				  (if (r0 == ? )
+				      (repeat)
+				    (break)))))
+		    ;; '=' [\t ]* r0:[^\t ]
+		    (branch
+		     r0
+		     ,@(mapcar
+			(lambda (r0)
+			  (cond
+			   ((eq r0 ?\r)
+			    ;; '=' [\t ]* r0='\r'
+			    `((read r0)
+			      ;; '=' [\t ]* '\r' r0
+			      (if (r0 == ?\n)
+				  ;; '=' [\t ]* '\r' r0='\n'
+				  ;; soft line break found.
+				  ((read r0)
+				   (repeat))
+				;; '=' [\t ]* '\r' r0:[^\n]
+				;; invalid input ->
+				;; output "=\r" and rescan from r0.
+				((write "=\r")
+				 (repeat)))))
+			   ((setq tmp (nth r0 ew-ccl-256-to-16-table))
+			    ;; '=' [\t ]* r0:[0-9A-F]
+			    `(r0 = ,tmp))
+			   (t
+			    ;; '=' [\t ]* r0:[^\r0-9A-F]
+			    ;; invalid input ->
+			    ;; output "=" and rescan from r0.
+			    `((write ?=)
+			      (repeat)))))
+			ew-ccl-256-table))
+		    ;; '=' [\t ]* r0:[0-9A-F]
+		    (read-branch
+		     r1
+		     ,@(mapcar
+			(lambda (r1)
+			  (if (setq tmp (nth r1 ew-ccl-256-to-16-table))
+			      ;; '=' [\t ]* [0-9A-F] r1:[0-9A-F]
+			      `(write-read-repeat
+				r0
+				,(vconcat
+				  (mapcar
+				   (lambda (r0)
+				     (logior (lsh r0 4) tmp))
+				   ew-ccl-16-table)))
+			    ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F]
+			    ;; invalid input
+			    `(r2 = 0)	; nop
+			    ))
+			ew-ccl-256-table))
+		    (write ?=)
+		    (write r0 ,(vconcat ew-ccl-16-to-256-table))
+		    (write r1)
+		    (read r0)
+		    (repeat)))
+		 ((eq tmp 'cr)
+		  ;; r0='\r'
+		  `((read r0)
+		    ;; '\r' r0
+		    (if (r0 == ?\n)
+			;; '\r' r0='\n'
+			;; hard line break found.
+			((write ?\r)
+			 (write-read-repeat r0))
+		      ;; '\r' r0:[^\n]
+		      ;; invalid control character (bare CR) found.
+		      ;; -> ignore it and rescan from r0.
+		      (repeat))))
+		 (t
+		  ;; r0:[^\t\r -~]
+		  ;; invalid character found.
+		  ;; -> ignore.
+		  `((read r0)
+		    (repeat))))))
+	    ew-ccl-256-table)))))))
+
 ;;;
 
 (make-coding-system 'ew-ccl-uq 4 ?Q "MIME Q-encoding in unstructured field"
@@ -657,6 +760,11 @@
 (make-coding-system 'ew-ccl-base64 4 ?B "MIME Base64-encoding"
 		    (cons ew-ccl-decode-b ew-ccl-encode-base64))
 
+(make-coding-system 'ew-ccl-quoted-printable 4 ?B
+		    "MIME Quoted-Printable-encoding"
+		    (cons ew-ccl-decode-quoted-printable
+			  ew-ccl-encode-quoted-printable))
+
 ;;;
 
 (eval-and-compile