X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Ftm.git;a=blobdiff_plain;f=tiny-mime.el;h=7bc4bb7b8a1d7a66dbc20e26a78b472aa176dc3c;hp=85b6e48d0d349cab7f5d21e078df28db1d5c90ec;hb=d1f12c89ac3491cdbbba0e24173e9b31f79ba73a;hpb=a2830b103396ae7af01c96e33f5b4f5df71a7b0a

diff --git a/tiny-mime.el b/tiny-mime.el
index 85b6e48..7bc4bb7 100644
--- a/tiny-mime.el
+++ b/tiny-mime.el
@@ -6,18 +6,22 @@
 ;;;	mime.el,v 1.5 1992/07/18 07:52:08 by Enami Tsugutomo
 ;;;
 
+
 ;;; @ require modules
 ;;;
+
 (require 'emu)
+(require 'mel)
 (require 'tl-header)
 (require 'tl-str)
-(require 'tl-num)
+(require 'tm-def)
 
 
 ;;; @ version
 ;;;
+
 (defconst mime/RCS-ID
-  "$Id: tiny-mime.el,v 5.18 1995/08/26 18:38:37 morioka Exp $")
+  "$Id: tiny-mime.el,v 6.7 1995/09/20 12:17:28 morioka Exp $")
 
 (defconst mime/tiny-mime-version (get-version-string mime/RCS-ID))
 
@@ -25,34 +29,11 @@
 ;;; @ MIME encoded-word definition
 ;;;
 
-(defconst mime/charset-regexp "[A-Za-z0-9!#$%&'*+---^_`{}|~]")
 (defconst mime/encoded-text-regexp "[!->@-~]+")
-
-(defconst mime/Base64-token-regexp "[A-Za-z0-9+/=]")
-(defconst mime/Base64-encoded-text-regexp
-  (concat "\\("
-	      mime/Base64-token-regexp
-	      mime/Base64-token-regexp
-	      mime/Base64-token-regexp
-	      mime/Base64-token-regexp
-	      "\\)+"))
-(defconst mime/Base64-encoding-and-encoded-text-regexp
-  (concat "\\(B\\)\\?" mime/Base64-encoded-text-regexp))
-
-(defconst mime/Quoted-Printable-hex-char-regexp "[0123456789ABCDEF]")
-(defconst mime/Quoted-Printable-octet-regexp
-  (concat "="
-	  mime/Quoted-Printable-hex-char-regexp
-	  mime/Quoted-Printable-hex-char-regexp))
-(defconst mime/Quoted-Printable-encoded-text-regexp
-  (concat "\\([^=?]\\|" mime/Quoted-Printable-octet-regexp "\\)+"))
-(defconst mime/Quoted-Printable-encoding-and-encoded-text-regexp
-  (concat "\\(Q\\)\\?" mime/Quoted-Printable-encoded-text-regexp))
-
 (defconst mime/encoded-word-regexp (concat (regexp-quote "=?")
 					   "\\("
 					   mime/charset-regexp
-					   "+\\)"
+					   "\\)"
 					   (regexp-quote "?")
 					   "\\(B\\|Q\\)"
 					   (regexp-quote "?")
@@ -90,28 +71,32 @@
 (defvar mime/use-X-Nsubject nil)
 
 
-;;; @ compatible module among Mule, NEmacs and NEpoch 
-;;;
-(cond ((boundp 'MULE)  (require 'tm-mule))
-      ((boundp 'NEMACS)(require 'tm-nemacs))
-      (t               (require 'tm-orig))
-      )
-
-
 ;;; @ Application Interface
 ;;;
 
 ;;; @@ MIME header decoders
 ;;;
 
-;; by mol. 1993/10/4
+(defun mime/decode-encoded-text (charset encoding str)
+  (let ((dest
+	 (cond ((string= "B" encoding)
+		(base64-decode-string str))
+	       ((string= "Q" encoding)
+		(q-encoding-decode-string str))
+	       (t (message "unknown encoding %s" encoding)
+		  nil))))
+    (if dest
+	(mime/convert-string-to-emacs charset dest)
+      )))
+
 (defun mime/decode-encoded-word (word)
-  (if (string-match mime/encoded-word-regexp word)
-      (let ((charset (upcase (mime/encoded-word-charset word)))
-	    (encoding (mime/encoded-word-encoding word))
-	    (text (mime/encoded-word-encoded-text word)))
-	(mime/decode-encoded-text charset encoding text))
-    word))
+  (or (if (string-match mime/encoded-word-regexp word)
+	  (let ((charset (upcase (mime/encoded-word-charset word)))
+		(encoding (upcase (mime/encoded-word-encoding word)))
+		(text (mime/encoded-word-encoded-text word)))
+	    (mime/decode-encoded-text charset encoding text)
+	    ))
+      word))
 
 (defun mime/decode-region (beg end)
   (interactive "*r")
@@ -151,7 +136,8 @@
 	    )
 	)
       (setq end (match-end 0))
-      (setq dest (concat dest (mime/decode-encoded-word (substring str beg end))
+      (setq dest (concat dest
+			 (mime/decode-encoded-word (substring str beg end))
 			 ))
       (setq str (substring str end))
       (setq ew t)
@@ -163,9 +149,8 @@
 ;;;
 
 (defun mime/encode-string (string encoding &optional mode)
-  (cond ((equal encoding "B") (mime/base64-encode-string string))
-	((equal encoding "Q") (mime/Quoted-Printable-encode-string string mode))
-	(t nil)
+  (cond ((string= encoding "B") (base64-encode-string string))
+	((string= encoding "Q") (q-encoding-encode-string string mode))
 	))
 
 (defun mime/encode-field (str)
@@ -208,6 +193,11 @@
 		  ))
     ))
 
+(defun mime/exist-encoded-word-in-subject ()
+  (let ((str (message/get-field-body "Subject")))
+    (if (and str (string-match mime/encoded-word-regexp str))
+	str)))
+
 (defun mime/encode-message-header ()
   (interactive "*")
   (save-excursion
@@ -215,7 +205,8 @@
       (narrow-to-region (goto-char (point-min))
 			(progn
 			  (re-search-forward
-			   (concat "^" (regexp-quote mail-header-separator) "$")
+			   (concat
+			    "^" (regexp-quote mail-header-separator) "$")
 			   nil t)
 			  (match-beginning 0)
 			  ))
@@ -232,188 +223,14 @@
 		     )))
 	  ))
       (if mime/use-X-Nsubject
-	  (progn
-	    (goto-char (point-min))
-	    (if (re-search-forward "^Subject:.*\\(\n\\s +.*\\)*" nil t)
-		(let ((str (buffer-substring (match-beginning 0)(match-end 0))))
-		  (if (string-match mime/encoded-word-regexp str)
-		      (insert (concat
-			       "\nX-Nsubject: "
-			       (nth 1 (message/divide-field
-				       (mime/decode-string
-					(message/unfolding-string str))
-				       ))))
-		    ))
-	      )))
+	  (let ((str (mime/exist-encoded-word-in-subject)))
+	    (if str
+		(insert (concat
+			 "\nX-Nsubject: "
+			 (mime/decode-string (message/unfolding-string str))
+			 )))))
       )))
 
-;;; @ Base64 (B-encode) decoder/encoder
-;;;	by Enami Tsugutomo
-;;;	modified by mol.
-
-(defun mime/base64-decode-string (string)
-  (mime/base64-mapconcat (function mime/base64-decode-chars) 4 string))
-
-;; (mime/base64-encode-string (mime/base64-decode-string "GyRAOjRGI0stGyhK"))
-(defun mime/base64-encode-string (string &optional mode)
-  (let ((es (mime/base64-mapconcat (function mime/base64-encode-chars) 3 string))
-	m)
-    (setq m (mod (length es) 4))
-    (concat es
-	    (cond ((= m 3) "=")
-		  ((= m 2) "==")
-		  ))
-    ))
-
-;; (char-to-string (mime/base64-bit-to-char 26))
-(defun mime/base64-bit-to-char (n)
-  (cond ((eq n nil) ?=)
-	((< n 26) (+ ?A n))
-	((< n 52) (+ ?a (- n 26)))
-	((< n 62) (+ ?0 (- n 52)))
-	((= n 62) ?+)
-	((= n 63) ?/)
-	(t (error "not a base64 integer %d" n))))
-
-(defun mime/base64-char-to-bit (c)
-  (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A))
-	((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26))
-	((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52))
-	((= c ?+) 62)
-	((= c ?/) 63)
-	((= c ?=) nil)
-	(t (error "not a base64 character %c" c))))
-
-(defun mime/mask (i n) (logand i (1- (ash 1 n))))
-
-(defun mime/base64-encode-1 (a &optional b &optional c)
-  (cons (ash a -2)
-	(cons (logior (ash (mime/mask a 2) (- 6 2))
-		      (if b (ash b -4) 0))
-	      (if b
-		  (cons (logior (ash (mime/mask b 4) (- 6 4))
-				(if c (ash c -6) 0))
-			(if c
-			    (cons (mime/mask c (- 6 0))
-				  nil)))))))
-
-(defun mime/base64-decode-1 (a b &optional c &optional d)
-  (cons (logior (ash a 2) (ash b (- 2 6)))
-	(if c (cons (logior (ash (mime/mask b 4) 4)
-			    (mime/mask (ash c (- 4 6)) 4))
-		    (if d (cons (logior (ash (mime/mask c 2) 6) d)
-				nil))))))
-
-;; (mime/base64-decode-chars ?G ?y ?R ?A)
-(defun mime/base64-decode-chars (a b c d)
-  (apply (function mime/base64-decode-1)
-	 (mapcar (function mime/base64-char-to-bit)
-		 (list a b c d))))
-
-;; (mapcar (function char-to-string) (mime/base64-encode-chars 27 36 64))
-(defun mime/base64-encode-chars (a b c)
-  (mapcar (function mime/base64-bit-to-char) (mime/base64-encode-1 a b c)))
-
-(defun mime/base64-fecth-from (func from pos len)
-  (let (ret)
-    (while (< 0 len)
-      (setq len (1- len)
-	    ret (cons (funcall func from (+ pos len)) ret)))
-    ret))
-
-(defun mime/base64-fecth-from-buffer (from pos len)
-  (mime/base64-fecth-from (function (lambda (f p) (char-after p)))
-			  from pos len))
-
-(defun mime/base64-fecth-from-string (from pos len)
-  (mime/base64-fecth-from (function (lambda (f p)
-				      (if (< p (length f)) (aref f p))))
-			  from pos len))
-
-(defun mime/base64-fecth (source pos len)
-  (cond ((stringp source) (mime/base64-fecth-from-string source pos len))
-	(t (mime/base64-fecth-from-buffer source pos len))))
-
-(defun mime/base64-mapconcat (func unit string)
-  (let ((i 0) ret)
-    (while (< i (length string))
-      (setq ret 
-	    (apply (function concat)
-		   ret
-		   (mapcar (function char-to-string)
-			   (apply func (mime/base64-fecth string i unit)))))
-      (setq i (+ i unit)))
-    ret))
-
-;;; @ Quoted-Printable (Q-encode) encoder/decoder
-;;;
-
-(defun mime/Quoted-Printable-decode-string (str)
-  (let ((dest "")
-	(len (length str))
-	(i 0) chr num h l)
-    (while (< i len)
-      (setq chr (elt str i))
-      (cond ((eq chr ?=)
-	     (if (< (+ i 2) len)
-		 (progn
-		   (setq h (hex-char-to-number (elt str (+ i 1))))
-		   (setq l (hex-char-to-number (elt str (+ i 2))))
-		   (setq num (+ (* h 16) l))
-		   (setq dest (concat dest (char-to-string num)))
-		   (setq i (+ i 3))
-		   )
-	       (progn
-		 (setq dest (concat dest (char-to-string chr)))
-		 (setq i (+ i 1))
-		 )))
-	    ((eq chr ?_)
-	     (setq dest (concat dest (char-to-string 32)))
-	     (setq i (+ i 1))
-	     )
-	    (t
-	     (setq dest (concat dest (char-to-string chr)))
-	     (setq i (+ i 1))
-	     ))
-      )
-    dest))
-
-(defun mime/Quoted-Printable-encode-string (str &optional mode)
-  (if (null mode)
-      (setq mode 'phrase))
-  (let ((dest "")
-	(len (length str))
-	(i 0) chr)
-    (while (< i len)
-      (setq chr (elt str i))
-      (cond ((eq chr 32)
-	     (setq dest (concat dest "_"))
-	     )
-	    ((or (eq chr ?=)
-		 (eq chr ??)
-		 (eq chr ?_)
-		 (and (eq mode 'comment)
-		      (or (eq chr ?\()
-			  (eq chr ?\))
-			  (eq chr ?\\)
-			  ))
-		 (and (eq mode 'phrase)
-		      (not (string-match "[A-Za-z0-9!*+/=_---]"
-					 (char-to-string chr)))
-		      )
-		 (< chr 32)
-		 (> chr 126))
-	     (setq dest (concat dest
-				"="
-				(char-to-string (number-to-hex-char (/ chr 16)))
-				(char-to-string (number-to-hex-char (% chr 16)))
-				))
-	     )
-	    (t (setq dest (concat dest (char-to-string chr)))
-	       ))
-      (setq i (+ i 1))
-      )
-    dest))
 
 ;;; @ functions for message header encoding
 ;;;
@@ -433,7 +250,9 @@
 	      (while (and (< i len)
 			  (setq js (mime/convert-string-from-emacs
 				    (substring string 0 i) charset))
-			  (setq m (+ n (mime/encoded-word-length js encoding) cesl))
+			  (setq m (+ n
+				     (mime/encoded-word-length js encoding)
+				     cesl))
 			  (< m 76))
 		(setq j i)
 		(setq i (+ i (char-bytes (elt string i))))
@@ -454,14 +273,17 @@
 
 (defun mime/encode-header-word (n string charset encoding)
   (let (dest str ret m)
-    (if (null (setq ret (mime/encode-and-split-string n string charset encoding)))
+    (if (null (setq ret
+		    (mime/encode-and-split-string n string charset encoding)))
 	nil
       (progn
 	(setq dest (nth 1 ret))
 	(setq m (car ret))
 	(setq str (nth 2 ret))
 	(while (and (stringp str)
-		    (setq ret (mime/encode-and-split-string 1 str charset encoding))
+		    (setq ret
+			  (mime/encode-and-split-string
+			   1 str charset encoding))
 		    )
 	  (setq dest (concat dest "\n " (nth 1 ret)))
 	  (setq m (car ret))
@@ -795,15 +617,7 @@
   (let (field beg end)
     (while (re-search-forward message/field-name-regexp nil t)
       (setq beg (match-beginning 0))
-      (setq end (progn
-		  (if (re-search-forward "\n[!-9;-~]+:" nil t)
-		      (goto-char (match-beginning 0))
-		    (if (re-search-forward "^$" nil t)
-			(goto-char (1- (match-beginning 0)))
-		      (end-of-line)
-		      ))
-		  (point)
-		  ))
+      (setq end (message/field-end))
       (setq field (buffer-substring beg end))
       (if (string-match mime/encoded-word-regexp field)
 	  (save-restriction