;;;
;;; A multilingual MIME message header encoder/decoder.
;;;	by Morioka Tomohiko (morioka@jaist.ac.jp)
;;;
;;; original MIME decoder is
;;;	mime.el,v 1.5 1992/07/18 07:52:08 by Enami Tsugutomo
;;;

(provide 'tiny-mime)


;;; @ require modules
;;;
(require 'tl-header)
(require 'tl-str)
(if (not (fboundp 'member))
    (require 'tl-18)
  )


;;; @ version
;;;
(defconst mime/RCS-ID
  "$Id: tiny-mime.el,v 5.11 1995/04/18 12:28:22 morioka Exp $")

(defconst mime/tiny-mime-version (get-version-string mime/RCS-ID))


;;; @ 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 "?")
					   "\\("
					   mime/encoded-text-regexp
					   "\\)"
					   (regexp-quote "?=")))

(defun mime/nth-string (s n)
  (if (stringp s)
      (substring s (match-beginning n) (match-end n))
    (buffer-substring (match-beginning n) (match-end n))))

(defun mime/encoded-word-charset (str)
  (mime/nth-string str 1))

(defun mime/encoded-word-encoding (str)
  (mime/nth-string str 2))

(defun mime/encoded-word-encoded-text (str)
  (mime/nth-string str 3))

(defun mime/rest-of-string (str)
  (if (stringp str)
      (substring str (match-end 0))
    (buffer-substring (match-end 0)(point-max))
    ))


;;; @ variables
;;;

(defvar mime/no-encoding-header-fields '("X-Nsubject"))

(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-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))

(defun mime/decode-region (beg end)
  (interactive "*r")
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (let (charset encoding text)
	(while (re-search-forward mime/encoded-word-regexp nil t)
	  (insert (mime/decode-encoded-word 
		   (prog1
		       (buffer-substring (match-beginning 0) (match-end 0))
		     (delete-region (match-beginning 0) (match-end 0))
		     )
		  ))
	  ))
      )))

(defun mime/decode-message-header ()
  (interactive "*")
  (save-excursion
    (save-restriction
      (narrow-to-region (goto-char (point-min))
			(progn (re-search-forward "^$" nil t) (point)))
      (mime/prepare-decode-message-header)
      (mime/decode-region (point-min) (point-max))
      )))

(defun mime/decode-string (str)
  (let ((dest "")(ew nil)
	beg end)
    (while (setq beg (string-match mime/encoded-word-regexp str))
      (if (> beg 0)
	  (if (not (and (eq ew t) (string= (substring str 0 beg) " ")))
	      (setq dest (concat dest (substring str 0 beg)
				 ))
	    )
	)
      (setq end (match-end 0))
      (setq dest (concat dest (mime/decode-encoded-word (substring str beg end))
			 ))
      (setq str (substring str end))
      (setq ew t)
      )
    (concat dest str)
    ))

;;; @@ MIME header encoders
;;;

(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)
	))

(defun mime/encode-field (str)
  (setq str (message/unfolding-string str))
  (let ((ret (message/divide-field str))
	field-name field-body)
    (setq field-name (car ret))
    (setq field-body (nth 1 ret))
    (concat field-name " "
	    (cond ((string= field-body "") "")
		  ((or (string-match "^Reply-To:$" field-name)
		       (string-match "^From:$" field-name)
		       (string-match "^Sender:$" field-name)
		       (string-match "^Resent-Reply-To:$" field-name)
		       (string-match "^Resent-From:$" field-name)
		       (string-match "^Resent-Sender:$" field-name)
		       (string-match "^To:$" field-name)
		       (string-match "^Resent-To:$" field-name)
		       (string-match "^cc:$" field-name)
		       (string-match "^Resent-cc:$" field-name)
		       (string-match "^bcc:$" field-name)
		       (string-match "^Resent-bcc:$" field-name)
		       )
		   (mime/encode-address-list
		    (+ (length field-name) 1) field-body)
		   )
		  (t
		   (catch 'tag
		     (let ((r mime/no-encoding-header-fields) fn)
		       (while r
			 (setq fn (car r))
			 (if (string-match (concat "^" fn ":$") field-name)
			     (throw 'tag field-body)
			   )
			 (setq r (cdr r))
			 ))
		     (nth 1 (mime/encode-header-string
			     (+ (length field-name) 1) field-body))
		     ))
		  ))
    ))

(defun mime/encode-message-header ()
  (interactive "*")
  (save-excursion
    (save-restriction
      (narrow-to-region (goto-char (point-min))
			(progn
			  (re-search-forward
			   (concat "^" (regexp-quote mail-header-separator) "$")
			   nil t)
			  (match-beginning 0)
			  ))
      (goto-char (point-min))
      (let (beg end field)
	(while (re-search-forward "^.+:.*\\(\n\\s +.*\\)*" nil t)
	  (setq beg (match-beginning 0))
	  (setq end  (match-end 0))
	  (setq field (buffer-substring beg end))
	  (insert (mime/encode-field
		   (prog1
		       (buffer-substring beg end)
		     (delete-region beg end)
		     )))
	  ))
      (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))
				       ))))
		    ))
	      )))
      )))

;;; @ 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
;;;

(defun mime/encode-and-split-string (n string charset encoding)
  (let ((i 0) (j 0)
	(len (length string))
	(js (mime/convert-string-from-emacs string charset))
	(cesl (+ (length charset) (length encoding) 6 ))
	ewl m rest)
    (setq ewl (mime/encoded-word-length js encoding))
    (if (null ewl) nil
      (progn
	(setq m (+ n ewl cesl))
	(if (> m 76)
	    (progn
	      (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))
			  (< m 76))
		(setq j i)
		(setq i (+ i (char-bytes (elt string i))))
		)
	      (setq js (mime/convert-string-from-emacs
			(substring string 0 j) charset))
	      (setq m (+ n (mime/encoded-word-length js encoding) cesl))
	      (setq rest (substring string j))
	      )
	  (setq rest nil))
	(if (string= js "")
	    (list 1 "" string)
	  (list m (concat "=?" charset "?" encoding "?"
			  (mime/encode-string js encoding)
			  "?=") rest))
	))
    ))

(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)))
	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 dest (concat dest "\n " (nth 1 ret)))
	  (setq m (car ret))
	  (setq str (nth 2 ret))
	  )
	(list m dest)
	))
    ))

(defun mime/encode-header-string (n string &optional mode)
  (if (string= string "")
      (list n "")
    (let ((ssl (mime/separate-string-for-encoder string))
	  i len cell et w ew (dest "") b l)
      (setq len (length ssl))
      (setq cell (nth 0 ssl))
      (setq et (car cell))
      ;; string-width crashes when the argument is nil,
      ;; so replace the argument
      ;; (original modification by Kenji Rikitake 9-JAN-1995)
      (setq w (or (cdr cell) ""))
      (if (eq et nil)
	  (progn
	    (if (> (+ n (string-width w)) 76)
		(progn
		  (setq dest (concat dest "\n "))
		  (setq b 1)
		  )
	      (setq b n))
	    (setq dest (concat dest w))
	    (setq b (+ b (string-width w)))
	    )
	(progn
	  (setq ew (mime/encode-header-word n (cdr cell) (car et) (cdr et)))
	  (setq dest (nth 1 ew))
	  (setq b (car ew))
	  ))
      (setq i 1)
      (while (< i len)
	(setq cell (nth i ssl))
	(setq et (car cell))
	(setq w (cdr cell))
	(cond ((string-match "^[ \t]*$" w)
	       (setq b (+ b (string-width (cdr cell))))
	       (setq dest (concat dest (cdr cell)))
	       )
	      ((eq et nil)
	       (if (> (+ b (string-width w)) 76)
		   (progn
		     (if (eq (elt dest (- (length dest) 1)) 32)
			 (setq dest (substring dest 0 (- (length dest) 1)))
		       )
		     (setq dest (concat dest "\n " w))
		     (setq b (+ (length w) 1))
		     )
		 (setq l (length dest))
		 (if (and (>= l 2)
			  (eq (elt dest (- l 2)) ?\?)
			  (eq (elt dest (- l 1)) ?=)
			  )
		     (progn
		       (setq dest (concat dest " "))
		       (setq b (+ b 1))
		       ))
		 (setq dest (concat dest w))
		 (setq b (+ b (string-width w)))
		 ))
	      (t
	       (if (not (eq (elt dest (- (length dest) 1)) 32))
		   (progn
		     (setq dest (concat dest " "))
		     (setq b (+ b 1))
		     ))
	       (setq ew
		     (mime/encode-header-word b (cdr cell) (car et) (cdr et)))
	       (setq b (car ew)) 
	       (if (string-match "^\n" (nth 1 ew))
		   (setq dest (concat (substring dest 0 (- (length dest) 1))
				      (nth 1 ew)))
		 (setq dest (concat dest (nth 1 ew)))
		 )
	       ))
	(setq i (+ i 1))
	)
      (list b dest)
      )))

(defun mime/encode-address-list (n str)
  (let* ((ret (message/parse-addresses str))
	 (r ret) cell en-ret j cl (dest "") s)
    (while r
      (setq cell (car r))
      (cond ((string= (nth 1 cell) "<")
	     (setq en-ret (mime/encode-header-string n (nth 0 cell) 'phrase))
	     (setq dest (concat dest (nth 1 en-ret)))
	     (setq n (car en-ret))
	     (if (> (length r) 1)
		 (setq en-ret
		       (mime/encode-header-string
			n (concat (nth 1 cell)(nth 2 cell)(nth 3 cell) ", "))) 
	       (setq en-ret (mime/encode-header-string
			     n (concat (nth 1 cell)(nth 2 cell)(nth 3 cell))))
	       )
	     (if (and (eq (elt (nth 1 en-ret) 0) ?\n)
		      (eq (elt dest (- (length dest) 1)) 32))
		 (setq dest (substring dest 0 (- (length dest) 1)))
	       )
	     (setq dest (concat dest (nth 1 en-ret)))
	     (setq n (car en-ret))
	     )
	    ((= (length cell) 4)
	     (setq en-ret (mime/encode-header-string n (nth 0 cell)))
	     (setq dest (concat dest (nth 1 en-ret)))
	     (setq n (car en-ret))
	     
	     (setq en-ret (mime/encode-header-string (+ n 2) (nth 2 cell)
						     'comment))
	     (if (eq (elt (nth 1 en-ret) 0) ?\n)
		 (progn
		   (setq dest (concat dest "\n ("))
		   (setq en-ret (mime/encode-header-string 2 (nth 2 cell)
							   'comment))
		   )
	       (progn
		 (setq dest (concat dest " ("))
		 ))
	     (setq dest (concat dest (nth 1 en-ret)))
	     (setq n (car en-ret))
	     (if (> (length r) 1)
		 (setq en-ret
		       (mime/encode-header-string n (concat (nth 3 cell) ", "))
		       )
	       (setq en-ret (mime/encode-header-string n (nth 3 cell)))
	       )
	     (setq dest (concat dest (nth 1 en-ret)))
	     (setq n (car en-ret))
	     )
	    (t
	     (if (> (length r) 1)
		 (setq en-ret
		       (mime/encode-header-string n (concat (nth 0 cell) ", "))
		       )
	       (setq en-ret (mime/encode-header-string n (nth 0 cell)))
	       )
	     (setq dest (concat dest (nth 1 en-ret)))
	     (setq n (car en-ret))
	     ))
      (setq r (cdr r))
      )
    dest))

;;; @ utility functions
;;;

;; by mol. 1993/10/4
(defun hex-char-to-number (chr)
  (cond ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0))
	((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10))
	((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10))
	))

(defun number-to-hex-char (n)
  (if (< n 10)
      (+ ?0 n)
    (+ ?A (- n 10))))


;;; @ utility for encoder
;;;

;;; @@ encoded-word length
;;;

(defun mime/encoded-word-length (string encoding)
  (cond ((equal encoding "B") (mime/base64-length string))
	((equal encoding "Q") (mime/Quoted-Printable-length string))
	(t nil)
	))

(defun mime/base64-length (string)
  (let ((l (length string))
	)
    (* (+ (/ l 3)
	  (if (= (mod l 3) 0) 0 1)
	  ) 4)
    ))

(defun mime/Quoted-Printable-length (string &optional mode)
  (let ((l 0)(i 0)(len (length string)) chr)
    (while (< i len)
      (setq chr (elt string i))
      (if (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))
	  (setq l (+ l 1))
	(setq l (+ l 3))
	)
      (setq i (+ i 1)) )
    l))

;;; @@ separate by character set
;;;

;; by mol. 1993/11/2
(defconst LC-space 2)

;; by mol. 1993/10/16
(defun mime/char-type (chr)
  (if (or (= chr 32)(= chr ?\t))
      LC-space
    (get-lc chr)
    ))

(defun mime/separate-string-by-chartype (string)
  (let ((len (length string))
	(dest nil) (ds "") s
	pcs i j cs chr)
    (if (= len 0) nil
      (progn
	(setq chr (elt string 0))
	(setq pcs (mime/char-type chr))
	(setq i (char-bytes chr))
	(setq ds (substring string 0 i))
	(while (< i len)
	  (setq chr (elt string i))
	  (setq cs (mime/char-type chr))
	  (setq j (+ i (char-bytes chr)))
	  (setq s (substring string i j))
	  (setq i j)
	  (if (= cs pcs)
	      (setq ds (concat ds s))
	    (progn (setq dest (append dest (list (cons pcs ds))))
		   (setq pcs cs)
		   (setq ds s)
		   ))
	  )
	(if (not (string= ds ""))
	    (setq dest (append dest (list (cons pcs ds)))))
	dest)
      )))

(defun mime/separate-string-by-charset (str)
  (let ((rl (mime/separate-string-by-chartype str))
	(i 1) len (pcell nil) cell ncell dpcell (dest nil) LC)
    (setq len (length rl))
    (setq dpcell (list (nth 0 rl)))
    (setq cell (nth 1 rl))
    (setq ncell (nth 2 rl))
    (while (< i len)
      (setq LC (car (car dpcell)))
      (cond ((and (not (eq LC lc-ascii))
		  (eq (car cell) LC-space)
		  (not (eq (car ncell) lc-ascii)))
	     (setq dpcell (list (cons LC
				      (concat (cdr (car dpcell)) (cdr cell))
				      )))
	     )
	    ((and (not (eq LC lc-ascii))
		  (eq LC (car cell)))
	     (setq dpcell (list (cons LC
				      (concat (cdr (car dpcell)) (cdr cell))
				      )))
	     )
	    ((and (eq LC lc-ascii)
		  (member (car cell) mime/latin-lc-list))
	     (setq dpcell (list (cons (car cell)
				      (concat (cdr (car dpcell)) (cdr cell))
				      )))
	     )
	    ((and (member LC mime/latin-lc-list)
		  (eq (car cell) lc-ascii))
	     (setq dpcell (list (cons LC
				      (concat (cdr (car dpcell)) (cdr cell))
				      )))
	     )
	    (t
	     (setq dest (append dest dpcell))
	     (setq dpcell (list cell))
	     ))
      (setq i (+ i 1))
      (setq cell ncell)
      (setq ncell (nth (+ i 1) rl))
      )
    (setq dest (append dest dpcell))
    ))

(defun mime/separate-string-for-encoder (string)
  (let (lastspace)
    (if (string-match "[ \t]+$" string)
	(progn
	  (setq lastspace (substring string
				     (match-beginning 0)
				     (match-end 0)))
	  (setq string (substring string 0 (match-beginning 0)))
	  ))
    (let ((rl (mime/separate-string-by-charset string))
	  (i 0) len cell0 cell1 cell2 (dest nil))
      (setq len (length rl))
      (setq cell0 (nth 0 rl))
      (setq cell1 (nth 1 rl))
      (setq cell2 (nth 2 rl))
      (while (< i len)
	(cond ((and (not (eq (car cell0) lc-ascii))
		    (eq (car cell1) LC-space)
		    (not (eq (car cell2) lc-ascii))
		    )
	       (setq dest
		     (append dest (list
				   (cons
				    (cdr (assoc (car cell0)
						mime/lc-charset-and-encoding-alist))
				    (concat (cdr cell0) (cdr cell1))
				    ))))
	       (setq i (+ i 2))
	       (setq cell0 (nth i rl))
	       (setq cell1 (nth (+ i 1) rl))
	       (setq cell2 (nth (+ i 2) rl))
	       )
	      (t
	       (setq dest
		     (append dest (list
				   (cons
				    (cdr (assoc (car cell0)
						mime/lc-charset-and-encoding-alist))
				    (cdr cell0)))))
	       (setq i (+ i 1))
	       (setq cell0 cell1)
	       (setq cell1 cell2)
	       (setq cell2 (nth (+ i 2) rl))
	       ))
	)
      (append dest
	      (if lastspace
		  (list (cons nil lastspace))))
      )))
	      
	      

;;;
;;; basic functions for MIME header decoder
;;;

;;; @ utility for decoder
;;;

(defun mime/unfolding ()
  (goto-char (point-min))
  (let (field beg end)
    (while (re-search-forward message/field-regexp nil t)
      (setq beg (match-beginning 0))
      (setq end  (match-end 0))
      (setq field (buffer-substring beg end))
      (if (string-match mime/encoded-word-regexp field)
	  (progn
	    (save-excursion
	      (save-restriction
		(narrow-to-region (goto-char beg) end)
		(while (re-search-forward "\n[ \t]+" nil t)
		  (replace-match " ")
		  )
		))
	    ))
      ))
  )

(defun mime/prepare-decode-message-header ()
  (mime/unfolding)
  (goto-char (point-min))
  (while (re-search-forward
	  (concat (regexp-quote "?=")
		  "\\s +"
		  (regexp-quote "=?"))
	  nil t)
    (replace-match "?==?")
    )
  )

(run-hooks 'mime/tiny-mime-load-hook)

;;; @
;;; Local Variables:
;;; mode: emacs-lisp
;;; mode: outline-minor
;;; outline-regexp: ";;; @+\\|(......"
;;; End: