From: morioka <morioka>
Date: Wed, 24 Jun 1998 05:47:29 +0000 (+0000)
Subject: Sync up with flim-1_6_0.
X-Git-Tag: chao-199811302358~1
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=8aaeaa3aca143e823578823cb867cd4739a37f1d;p=elisp%2Fflim.git

Sync up with flim-1_6_0.
---

diff --git a/eword-decode.el b/eword-decode.el
index 0e3f3ca..5280aeb 100644
--- a/eword-decode.el
+++ b/eword-decode.el
@@ -310,7 +310,7 @@ If SEPARATOR is not nil, it is used as header separator."
 			 ;; Don't decode
 			 (insert-buffer-substring src-buf p end)
 			 )
-			((memq field-name eword-decode-structured-field-list)
+			((memq field eword-decode-structured-field-list)
 			 ;; Decode as structured field
 			 (let ((body (save-excursion
 				       (set-buffer src-buf)
diff --git a/mel-b.el b/mel-b.el
index 4c16f5e..e9a382a 100644
--- a/mel-b.el
+++ b/mel-b.el
@@ -103,18 +103,19 @@ external decoder is called.")
 		(base64-num-to-char (ash (logand a 3) 4))) "==")
        ))))
 
-(defun base64-decode-1 (pack)
-  (let ((a (base64-char-to-num (car pack)))
-	(b (base64-char-to-num (nth 1 pack)))
-	(c (nth 2 pack))
-	(d (nth 3 pack)))
-    (concat (char-to-string (logior (ash a 2) (ash b -4)))
-	    (if (and c (setq c (base64-char-to-num c)))
-		(concat (char-to-string
-			 (logior (ash (logand b 15) 4) (ash c -2)))
-			(if (and d (setq d (base64-char-to-num d)))
-			    (char-to-string (logior (ash (logand c 3) 6) d))
-			  ))))))
+(defun base64-decode-unit (a b &optional c d)
+  (condition-case err
+      (concat
+       (char-to-string (logior (ash (base64-char-to-num a) 2)
+			       (ash (setq b (base64-char-to-num b)) -4)))
+       (if (and c (setq c (base64-char-to-num c)))
+	   (concat (char-to-string
+		    (logior (ash (logand b 15) 4) (ash c -2)))
+		   (if (and d (setq d (base64-char-to-num d)))
+		       (char-to-string (logior (ash (logand c 3) 6) d))
+		     ))))
+    (error (message (nth 1 err))
+	   "")))
 
 
 ;;; @@ base64 encoder/decoder for string
@@ -148,11 +149,43 @@ external decoder is called.")
 			    ))
       )))
 
-(defun base64-decode-string (string)
-  "Decode STRING which is encoded in base64, and return the result."
-  (mapconcat (function base64-decode-1)
-	     (pack-sequence string 4)
-	     ""))
+(defun base64-internal-decode-string (string)
+  (let ((len (length string))
+	(i 0)
+	dest)
+    (while (< i len)
+      (let ((a (aref string i)))
+	(setq i (1+ i))
+	(unless (eq a ?\n)
+	  (let ((b (aref string i)))
+	    (setq i (1+ i))
+	    (cond
+	     ((eq b ?\n)
+	      ;; invalid
+	      )
+	     ((>= i len)
+	      (setq dest (concat dest (base64-decode-unit a b) ))
+	      )
+	     (t
+	      (let ((c (aref string i)))
+		(setq i (1+ i))
+		(cond
+		 ((eq c ?\n)
+		  (setq dest (concat dest (base64-decode-unit a b)))
+		  )
+		 ((>= i len)
+		  (setq dest (concat dest (base64-decode-unit a b c)))
+		  )
+		 (t
+		  (let ((d (aref string i)))
+		    (setq i (1+ i))
+		    (setq dest
+			  (concat dest
+				  (if (eq c ?\n)
+				      (base64-decode-unit a b c)
+				    (base64-decode-unit a b c d))))
+		    ))))))))))
+    dest))
 
 
 ;;; @ base64 encoder/decoder for region
@@ -173,31 +206,10 @@ external decoder is called.")
 
 (defun base64-internal-decode-region (beg end)
   (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char (point-min))
-      (while (looking-at ".*\n")
-	(condition-case err
-	    (replace-match
-	     (base64-decode-string
-	      (buffer-substring (match-beginning 0) (1- (match-end 0))))
-	     t t)
-	  (error
-	   (prog1
-	       (message (nth 1 err))
-	     (replace-match "")))))
-      (if (looking-at ".*$")
-	  (condition-case err
-	      (replace-match
-	       (base64-decode-string
-		(buffer-substring (match-beginning 0) (match-end 0)))
-	       t t)
-	    (error
-	     (prog1
-		 (message (nth 1 err))
-	       (replace-match "")))
-	    ))
-      )))
+    (let ((str (buffer-substring beg end)))
+      (delete-region beg end)
+      (goto-char beg)
+      (insert (base64-internal-decode-string str)))))
 
 (defun base64-external-encode-region (beg end)
   (save-excursion
@@ -222,6 +234,17 @@ external decoder is called.")
 			      t t nil (cdr base64-external-decoder))
 		       )))
 
+(defun base64-external-decode-string (string)
+  (with-temp-buffer
+    (insert string)
+    (as-binary-process (apply (function call-process-region)
+			      (point-min) (point-max)
+			      (car base64-external-decoder)
+			      t t nil (cdr base64-external-decoder))
+		       )
+    (buffer-string)))
+
+
 (defun base64-encode-region (start end)
   "Encode current region by base64.
 START and END are buffer positions.
@@ -252,6 +275,20 @@ metamail or XEmacs package)."
     (base64-internal-decode-region start end)
     ))
 
+(defun base64-decode-string (string)
+  "Decode STRING which is encoded in base64, and return the result.
+This function calls internal base64 decoder if size of STRING is
+smaller than `base64-internal-decoding-limit', otherwise it calls
+external base64 decoder specified by `base64-external-decoder'.  In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
+  (interactive "r")
+  (if (and base64-internal-decoding-limit
+	   (> (length string) base64-internal-decoding-limit))
+      (base64-external-decode-string string)
+    (base64-internal-decode-string string)
+    ))
+
 
 ;;; @ base64 encoder/decoder for file
 ;;;
diff --git a/mel-q.el b/mel-q.el
index 130865e..47a7a2b 100644
--- a/mel-q.el
+++ b/mel-q.el
@@ -158,53 +158,37 @@ It calls external quoted-printable encoder specified by
 ;;; @ Quoted-Printable decoder
 ;;;
 
-(defun quoted-printable-decode-string (string)
-  "Decode STRING which is encoded in quoted-printable, and return the result."
-  (let (q h l)
-    (mapconcat (function
-		(lambda (chr)
-		  (cond ((eq chr ?=)
-			 (setq q t)
-			 "")
-			(q (setq h
-				 (cond ((<= ?a chr) (+ (- chr ?a) 10))
-				       ((<= ?A chr) (+ (- chr ?A) 10))
-				       ((<= ?0 chr) (- chr ?0))
-				       ))
-			   (setq q nil)
-			   "")
-			(h (setq l (cond ((<= ?a chr) (+ (- chr ?a) 10))
-					 ((<= ?A chr) (+ (- chr ?A) 10))
-					 ((<= ?0 chr) (- chr ?0))
-					 ))
-			   (prog1
-			       (char-to-string (logior (ash h 4) l))
-			     (setq h nil)
-			     )
-			   )
-			(t (char-to-string chr))
-			)))
-	       string "")))
+(defsubst quoted-printable-hex-char-to-num (chr)
+  (cond ((<= ?a chr) (+ (- chr ?a) 10))
+	((<= ?A chr) (+ (- chr ?A) 10))
+	((<= ?0 chr) (- chr ?0))
+	))
 
 (defun quoted-printable-internal-decode-region (start end)
   (save-excursion
     (save-restriction
       (narrow-to-region start end)
       (goto-char (point-min))
-      (while (re-search-forward "=\n" nil t)
-	(replace-match "")
-	)
-      (goto-char (point-min))
-      (let (b e str)
-	(while (re-search-forward quoted-printable-octet-regexp nil t)
-	  (setq b (match-beginning 0))
-	  (setq e (match-end 0))
-	  (setq str (buffer-substring b e))
-	  (delete-region b e)
-	  (insert (string-as-multibyte (quoted-printable-decode-string str)))
-	  ))
-      )))
-
+      (while (search-forward "=" nil t)
+	(let ((beg (match-beginning 0)))
+	  (cond ((looking-at "\n")
+		 (delete-region beg (match-end 0))
+		 )
+		((looking-at
+		  `,(concat "[" quoted-printable-hex-chars
+			    "][" quoted-printable-hex-chars "]"))
+		 (let* ((end (match-end 0))
+			(hex (buffer-substring (match-beginning 0) end)))
+		   (delete-region beg end)
+		   (insert
+		    (logior
+		     (ash (quoted-printable-hex-char-to-num (aref hex 0)) 4)
+		     (quoted-printable-hex-char-to-num (aref hex 1))))
+		   ))
+		(t
+		 ;; invalid
+		 ))
+	  )))))
 
 (defvar quoted-printable-external-decoder '("mmencode" "-q" "-u")
   "*list of quoted-printable decoder program name and its arguments.")
@@ -238,6 +222,13 @@ the program (maybe mmencode included in metamail or XEmacs package)."
     (quoted-printable-internal-decode-region start end)
     ))
 
+(defun quoted-printable-decode-string (string)
+  "Decode STRING which is encoded in quoted-printable, and return the result."
+  (with-temp-buffer
+    (insert string)
+    (quoted-printable-decode-region (point-min)(point-max))
+    (buffer-string)))
+
 
 (defvar quoted-printable-external-decoder-option-to-specify-file '("-o")
   "*list of options of quoted-printable decoder program to specify file.")
@@ -299,16 +290,10 @@ MODE allows `text', `comment', `phrase' or nil.  Default value is
 			((eq chr ?=)
 			 (setq q t)
 			 "")
-			(q (setq h (cond ((<= ?a chr) (+ (- chr ?a) 10))
-					 ((<= ?A chr) (+ (- chr ?A) 10))
-					 ((<= ?0 chr) (- chr ?0))
-					 ))
+			(q (setq h (quoted-printable-hex-char-to-num chr))
 			   (setq q nil)
 			   "")
-			(h (setq l (cond ((<= ?a chr) (+ (- chr ?a) 10))
-					 ((<= ?A chr) (+ (- chr ?A) 10))
-					 ((<= ?0 chr) (- chr ?0))
-					 ))
+			(h (setq l (quoted-printable-hex-char-to-num chr))
 			   (prog1
 			       (char-to-string (logior (ash h 4) l))
 			     (setq h nil)
diff --git a/mel.el b/mel.el
index 01efaf2..2ed43a4 100644
--- a/mel.el
+++ b/mel.el
@@ -28,8 +28,6 @@
 
 (require 'emu)
 
-(defconst mel-version "7.5")
-
 
 ;;; @ variable
 ;;;
@@ -183,6 +181,38 @@ region by its value."
       )))
 
 
+;;; @ string
+;;;
+
+;;;###autoload
+(defvar mime-string-decoding-method-alist
+  '(("base64"           . base64-decode-string)
+    ("quoted-printable" . quoted-printable-decode-string)
+    ("7bit"		. identity)
+    ("8bit"		. identity)
+    ("binary"		. identity)
+    )
+  "Alist of encoding vs. corresponding method to decode string.
+Each element looks like (STRING . FUNCTION).
+STRING is content-transfer-encoding.
+FUNCTION is string decoder.")
+
+;;;###autoload
+(defun mime-decode-string (string encoding)
+  "Decode STRING using ENCODING.
+ENCODING must be string.  If ENCODING is found in
+`mime-string-decoding-method-alist' as its key, this function decodes
+the STRING by its value."
+  (let ((f (cdr (assoc encoding mime-string-decoding-method-alist))))
+    (if f
+	(funcall f string)
+      (with-temp-buffer
+	(insert string)
+	(mime-decode-region (point-min)(point-max) encoding)
+	(buffer-string)
+	))))
+
+
 ;;; @ file
 ;;;