X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mel-b-ccl.el;h=4a827721417a3edfb1eb4076da5b512f07cfce08;hb=87dac904ce3a0d0afa5c7b14fea6c92b180679be;hp=b01650c112e70b9ec421b31547bcd5c0679288f6;hpb=f7230fcb61e32630f6bcf87e6eb8b35c564dd06c;p=elisp%2Fflim.git

diff --git a/mel-b-ccl.el b/mel-b-ccl.el
index b01650c..4a82772 100644
--- a/mel-b-ccl.el
+++ b/mel-b-ccl.el
@@ -1,8 +1,8 @@
-;;; mel-b-ccl.el: CCL based encoder/decoder of Base64
+;;; mel-b-ccl.el --- Base64 encoder/decoder using CCL.
 
-;; Copyright (C) 1998 Tanaka Akira
+;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
 
-;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Author: Tanaka Akira <akr@m17n.org>
 ;; Created: 1998/9/17
 ;; Keywords: MIME, Base64
 
@@ -19,9 +19,9 @@
 ;; General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Code:
 
@@ -105,6 +105,10 @@ abcdefghijklmnopqrstuvwxyz\
    (logand v (lsh 255 8))
    (lsh (logand v 255) 16)))
 
+)
+
+(eval-when-compile
+
 (defconst mel-ccl-decode-b-0-table
   (vconcat
    (mapcar
@@ -143,101 +147,151 @@ abcdefghijklmnopqrstuvwxyz\
 
 )
 
-(define-ccl-program mel-ccl-decode-b
-  `(1
-    (loop
-     (read r0 r1 r2 r3)
-     (r4 = r0 ,mel-ccl-decode-b-0-table)
-     (r5 = r1 ,mel-ccl-decode-b-1-table)
-     (r4 |= r5)
-     (r5 = r2 ,mel-ccl-decode-b-2-table)
-     (r4 |= r5)
-     (r5 = r3 ,mel-ccl-decode-b-3-table)
-     (r4 |= r5)
-     (if (r4 & ,(lognot (1- (lsh 1 24))))
-	 ((loop
-	   (if (r4 & ,(lsh 1 24))
-	       ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
-		(r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
-		(r5 = r3 ,mel-ccl-decode-b-3-table)
-		(r4 |= r5)
-		(repeat))
-	     (break)))
-	  (loop
-	   (if (r4 & ,(lsh 1 25))
-	       ((r1 = r2) (r2 = r3) (read r3)
-		(r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
-		(r5 = r3 ,mel-ccl-decode-b-3-table)
-		(r4 |= r5)
-		(repeat))
-	     (break)))
-	  (loop
-	   (if (r2 != ?=)
-	       (if (r4 & ,(lsh 1 26))
-		   ((r2 = r3) (read r3)
-		    (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
-		    (r5 = r3 ,mel-ccl-decode-b-3-table)
-		    (r4 |= r5)
-		    (repeat))
-		 ((r6 = 0)
-		  (break)))
-	     ((r6 = 1)
-	      (break))))
-	  (loop
-	   (if (r3 != ?=)
-	       (if (r4 & ,(lsh 1 27))
-		   ((read r3)
-		    (r4 = r3 ,mel-ccl-decode-b-3-table)
-		    (repeat))
-		 (break))
-	     ((r6 |= 2)
-	      (break))))
-	  (r4 = r0 ,mel-ccl-decode-b-0-table)
-	  (r5 = r1 ,mel-ccl-decode-b-1-table)
-	  (r4 |= r5)
-	  (branch
-	   r6
-	   ;; BBBB
-	   ((r5 = r2 ,mel-ccl-decode-b-2-table)
-	    (r4 |= r5)
-	    (r5 = r3 ,mel-ccl-decode-b-3-table)
+(check-broken-facility ccl-cascading-read)
+
+(if-broken ccl-cascading-read
+    (define-ccl-program mel-ccl-decode-b
+      `(1
+	(loop
+	 (loop
+	  (read-branch
+	   r1
+	   ,@(mapcar
+	      (lambda (v)
+		(cond
+		 ((or (eq v nil) (eq v t)) '(repeat))
+		 (t `((r0 = ,(lsh v 2)) (break)))))
+	      mel-ccl-256-to-64-table)))
+	 (loop
+	  (read-branch
+	   r1
+	   ,@(mapcar
+	      (lambda (v)
+		(cond
+		 ((or (eq v nil) (eq v t)) '(repeat))
+		 ((= (lsh v -4) 0) `((write r0) (r0 = ,(lsh (logand v 15) 4)) (break)))
+		 (t `((r0 |= ,(lsh v -4)) (write r0) (r0 = ,(lsh (logand v 15) 4)) (break)))))
+	      mel-ccl-256-to-64-table)))
+	 (loop
+	  (read-branch
+	   r1
+	   ,@(mapcar
+	      (lambda (v)
+		(cond
+		 ((eq v nil) '(repeat))
+		 ((eq v t) '(end))
+		 ((= (lsh v -2) 0) `((write r0) (r0 = ,(lsh (logand v 3) 6)) (break)))
+		 (t `((r0 |= ,(lsh v -2)) (write r0) (r0 = ,(lsh (logand v 3) 6)) (break)))))
+	      mel-ccl-256-to-64-table)))
+	 (loop
+	  (read-branch
+	   r1
+	   ,@(mapcar
+	      (lambda (v)
+		(cond
+		 ((eq v nil) '(repeat))
+		 ((eq v t) '(end))
+		 (t `((r0 |= ,v) (write r0) (break)))))
+	      mel-ccl-256-to-64-table)))
+	 (repeat))))
+  (define-ccl-program mel-ccl-decode-b
+    `(1
+      (loop
+       (read r0 r1 r2 r3)
+       (r4 = r0 ,mel-ccl-decode-b-0-table)
+       (r5 = r1 ,mel-ccl-decode-b-1-table)
+       (r4 |= r5)
+       (r5 = r2 ,mel-ccl-decode-b-2-table)
+       (r4 |= r5)
+       (r5 = r3 ,mel-ccl-decode-b-3-table)
+       (r4 |= r5)
+       (if (r4 & ,(lognot (1- (lsh 1 24))))
+	   ((loop
+	     (if (r4 & ,(lsh 1 24))
+		 ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
+		  (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+		  (r5 = r3 ,mel-ccl-decode-b-3-table)
+		  (r4 |= r5)
+		  (repeat))
+	       (break)))
+	    (loop
+	     (if (r4 & ,(lsh 1 25))
+		 ((r1 = r2) (r2 = r3) (read r3)
+		  (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+		  (r5 = r3 ,mel-ccl-decode-b-3-table)
+		  (r4 |= r5)
+		  (repeat))
+	       (break)))
+	    (loop
+	     (if (r2 != ?=)
+		 (if (r4 & ,(lsh 1 26))
+		     ((r2 = r3) (read r3)
+		      (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+		      (r5 = r3 ,mel-ccl-decode-b-3-table)
+		      (r4 |= r5)
+		      (repeat))
+		   ((r6 = 0)
+		    (break)))
+	       ((r6 = 1)
+		(break))))
+	    (loop
+	     (if (r3 != ?=)
+		 (if (r4 & ,(lsh 1 27))
+		     ((read r3)
+		      (r4 = r3 ,mel-ccl-decode-b-3-table)
+		      (repeat))
+		   (break))
+	       ((r6 |= 2)
+		(break))))
+	    (r4 = r0 ,mel-ccl-decode-b-0-table)
+	    (r5 = r1 ,mel-ccl-decode-b-1-table)
 	    (r4 |= r5)
-	    (r4 >8= 0)
-	    (write r7)
-	    (r4 >8= 0)
-	    (write r7)
-	    (write-repeat r4))
-	   ;; error: BB=B 
-	   ((write (r4 & 255))
-	    (end))
-	   ;; BBB=
-	   ((r5 = r2 ,mel-ccl-decode-b-2-table)
-	    (r4 |= r5)
-	    (r4 >8= 0)
-	    (write r7)
-	    (write (r4 & 255))
-	    (end)			; Excessive (end) is workaround for XEmacs 21.0.
+	    (branch
+	     r6
+	     ;; BBBB
+	     ((r5 = r2 ,mel-ccl-decode-b-2-table)
+	      (r4 |= r5)
+	      (r5 = r3 ,mel-ccl-decode-b-3-table)
+	      (r4 |= r5)
+	      (r4 >8= 0)
+	      (write r7)
+	      (r4 >8= 0)
+	      (write r7)
+	      (write-repeat r4))
+	     ;; error: BB=B 
+	     ((write (r4 & 255))
+	      (end))
+	     ;; BBB=
+	     ((r5 = r2 ,mel-ccl-decode-b-2-table)
+	      (r4 |= r5)
+	      (r4 >8= 0)
+	      (write r7)
+	      (write (r4 & 255))
+	      (end)			; Excessive (end) is workaround for XEmacs 21.0.
 					; Without this, "AAA=" is converted to "^@^@^@".
-	    (end))
-	   ;; BB==
-	   ((write (r4 & 255))
-	    (end))))
-       ((r4 >8= 0)
-	(write r7)
-	(r4 >8= 0)
-	(write r7)
-	(write-repeat r4))))))
+	      (end))
+	     ;; BB==
+	     ((write (r4 & 255))
+	      (end))))
+	 ((r4 >8= 0)
+	  (write r7)
+	  (r4 >8= 0)
+	  (write r7)
+	  (write-repeat r4))))))
+  )
 
 (eval-when-compile
 
 ;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
 ;; is not executed.
-(defun mel-ccl-encode-base64-generic (&optional quantums-per-line output-crlf terminate-with-newline)
+(defun mel-ccl-encode-base64-generic
+  (&optional quantums-per-line output-crlf terminate-with-newline)
   `(2
     ((r3 = 0)
+     (r2 = 0)
+     (read r1)
      (loop
-      (r2 = 0)
-      (read-branch
+      (branch
        r1
        ,@(mapcar
           (lambda (r1)
@@ -278,6 +332,8 @@ abcdefghijklmnopqrstuvwxyz\
                      (nth r1 mel-ccl-64-to-256-table))
                    mel-ccl-64-table)))
       (r3 += 1)
+      (r2 = 0)
+      (read r1)
       ,@(when quantums-per-line
 	  `((if (r3 == ,quantums-per-line)
 		((write ,(if output-crlf "\r\n" "\n"))
@@ -345,19 +401,26 @@ abcdefghijklmnopqrstuvwxyz\
 
 (unless-broken ccl-execute-eof-block-on-decoding-some
 
-  (defun base64-ccl-encode-string (string)
+  (defun base64-ccl-encode-string (string &optional no-line-break)
     "Encode STRING with base64 encoding."
-    (decode-coding-string string 'mel-ccl-base64-lf-rev))
+    (if no-line-break
+	(decode-coding-string string 'mel-ccl-b-rev)
+      (decode-coding-string string 'mel-ccl-base64-lf-rev)))
+  (defalias-maybe 'base64-encode-string 'base64-ccl-encode-string)
 
-  (defun base64-ccl-encode-region (start end)
+  (defun base64-ccl-encode-region (start end &optional no-line-break)
     "Encode region from START to END with base64 encoding."
-    (interactive "r")
-    (decode-coding-region start end 'mel-ccl-base64-lf-rev))
+    (interactive "*r")
+    (if no-line-break
+	(decode-coding-region start end 'mel-ccl-b-rev)
+      (decode-coding-region start end 'mel-ccl-base64-lf-rev)))
+  (defalias-maybe 'base64-encode-region 'base64-ccl-encode-region)
 
   (defun base64-ccl-insert-encoded-file (filename)
     "Encode contents of file FILENAME to base64, and insert the result."
-    (interactive (list (read-file-name "Insert encoded file: ")))
-    (let ((coding-system-for-read 'mel-ccl-base64-lf-rev))
+    (interactive "*fInsert encoded file: ")
+    (let ((coding-system-for-read 'mel-ccl-base64-lf-rev)
+	  format-alist)
       (insert-file-contents filename)))
 
   (mel-define-method-function (mime-encode-string string (nil "base64"))
@@ -375,19 +438,19 @@ abcdefghijklmnopqrstuvwxyz\
 (defun base64-ccl-decode-string (string)
   "Decode base64 encoded STRING"
   (encode-coding-string string 'mel-ccl-b-rev))
+(defalias-maybe 'base64-decode-string 'base64-ccl-decode-string)
 
 (defun base64-ccl-decode-region (start end)
   "Decode base64 encoded the region from START to END."
-  (interactive "r")
+  (interactive "*r")
   (encode-coding-region start end 'mel-ccl-b-rev))
+(defalias-maybe 'base64-decode-region 'base64-ccl-decode-region)
 
 (defun base64-ccl-write-decoded-region (start end filename)
   "Decode the region from START to END and write out to FILENAME."
-  (interactive
-    (list (region-beginning) (region-end)
-          (read-file-name "Write decoded region to file: ")))
+  (interactive "*r\nFWrite decoded region to file: ")
   (let ((coding-system-for-write 'mel-ccl-b-rev)
-	jka-compr-compression-info-list)
+	jka-compr-compression-info-list jam-zcat-filename-list)
     (write-region start end filename)))
 
 (mel-define-method-function (mime-decode-string string (nil "base64"))
@@ -399,8 +462,9 @@ abcdefghijklmnopqrstuvwxyz\
  'base64-ccl-write-decoded-region)
 
 (mel-define-method encoded-text-decode-string (string (nil "B"))
-  (if (and (string-match B-encoded-text-regexp string)
-	   (string= string (match-string 0 string)))
+  (if (string-match (eval-when-compile
+		      (concat "\\`" B-encoded-text-regexp "\\'"))
+		    string)
       (base64-ccl-decode-string string)
     (error "Invalid encoded-text %s" string)))
 
@@ -410,4 +474,4 @@ abcdefghijklmnopqrstuvwxyz\
 
 (provide 'mel-b-ccl)
 
-;;; mel-b-ccl.el ends here
+;;; mel-b-ccl.el ends here.