;;;
;;; tm-ew-d.el --- RFC 1522 based multilingual MIME message header
;;;                decoder for GNU Emacs
;;;
;;; Copyright (C) 1995 Free Software Foundation, Inc.
;;; Copyright (C) 1992 ENAMI Tsugutomo
;;; Copyright (C) 1993 .. 1996 MORIOKA Tomohiko
;;;
;;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
;;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;; Created: 1993/6/3 (1995/10/3 obsolete tiny-mime.el)
;;; Version: $Revision: 7.12 $
;;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
;;;
;;; This file is part of tm (Tools for MIME).
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 2, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with This program.  If not, write to the Free Software
;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;; Code:

(require 'emu)
(require 'tl-822)
(require 'mel)
(require 'tm-def)


;;; @ version
;;;

(defconst tm-ew-d/RCS-ID
  "$Id: tm-ew-d.el,v 7.12 1996/05/09 18:18:51 morioka Exp $")
(defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID))


;;; @ MIME encoded-word definition
;;;

(defconst mime/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 "?=")))


;;; @ for string
;;;

(defun mime-eword/decode-string (str)
  (setq str (rfc822/unfolding-string str))
  (let ((dest "")(ew nil)
	beg end)
    (while (and (string-match mime/encoded-word-regexp str)
		(setq beg (match-beginning 0)
		      end (match-end 0))
		)
      (if (> beg 0)
	  (if (not
	       (and (eq ew t)
		    (string-match "^[ \t]+$" (substring str 0 beg))
		    ))
	      (setq dest (concat dest (substring str 0 beg)))
	    )
	)
      (setq dest (concat dest
			 (mime/decode-encoded-word (substring str beg end))
			 ))
      (setq str (substring str end))
      (setq ew t)
      )
    (concat dest str)
    ))


;;; @ for region
;;;

(defun mime-eword/decode-region (beg end &optional unfolding)
  (interactive "*r")
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (if unfolding
	  (mime/unfolding)
	)
      (goto-char (point-min))
      (while (re-search-forward
	      (concat (regexp-quote "?=") "\\s +" (regexp-quote "=?"))
	      nil t)
	(replace-match "?==?")
	)
      (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))
		     )
		   ))
	  ))
      )))


;;; @ for message header
;;;

(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-eword/decode-region (point-min) (point-max) t)
      )))

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


;;; @ encoded-word decoder
;;;

(defun mime/decode-encoded-word (word)
  (or (if (string-match mime/encoded-word-regexp word)
	  (let ((charset
		 (upcase
		  (substring word (match-beginning 1) (match-end 1))
		  ))
		(encoding
		 (upcase
		  (substring word (match-beginning 2) (match-end 2))
		  ))
		(text
		 (substring word (match-beginning 3) (match-end 3))
		 ))
	    (mime/decode-encoded-text charset encoding text)
	    ))
      word))


;;; @ encoded-text decoder
;;;

(defun mime/decode-encoded-text (charset encoding str)
  (let ((dest
	 (cond ((string-equal "B" encoding)
		(base64-decode-string str))
	       ((string-equal "Q" encoding)
		(q-encoding-decode-string str))
	       (t (message "unknown encoding %s" encoding)
		  nil))))
    (if dest
	(mime-charset-decode-string dest charset)
      )))


;;; @ end
;;;

(provide 'tm-ew-d)

;;; tm-ew-d.el ends here