;;; tm-ew-d.el --- RFC 1522 based MIME encoded-word decoder for GNU Emacs

;; Copyright (C) 1995,1996 Free Software Foundation, Inc.

;; 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.24 $
;; 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Code:

(require 'emu)
(require 'std11)
(require 'mel)
(require 'tm-def)


;;; @ version
;;;

(defconst tm-ew-d/RCS-ID
  "$Id: tm-ew-d.el,v 7.24 1996/08/28 15:42:49 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 &optional unfolding)
  (setq str (std11-unfold-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) unfolding)
		    ))
      (setq str (substring str end))
      (setq ew t)
      )
    (concat dest str)
    ))


;;; @ for region
;;;

(defun mime-eword/decode-region (beg end &optional unfolding must-unfold)
  "Decode MIME encoded-words in region between BEG and END.
If UNFOLDING is not nil, it unfolds before decoding.
If MUST-UNFOLD is not nil, it unfolds encoded results. [tm-ew-d.el]"
  (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))
		     ) must-unfold))
	  ))
      )))


;;; @ for message header
;;;

(defun mime/decode-message-header ()
  "Decode MIME encoded-words in message header. [tm-ew-d.el]"
  (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 std11-field-head-regexp nil t)
      (setq beg (match-beginning 0)
	    end (std11-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 &optional unfolding)
  (or (if (string-match mime/encoded-word-regexp word)
	  (let ((charset
		 (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 unfolding)
	    ))
      word))


;;; @ encoded-text decoder
;;;

(defun mime/decode-encoded-text (charset encoding str &optional unfolding)
  (let ((cs (mime-charset-to-coding-system charset)))
    (if cs
	(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
	      (progn
		(setq dest (decode-coding-string dest cs))
		(if unfolding
		    (std11-unfold-string dest)
		  dest)
		))))))


;;; @ end
;;;

(provide 'tm-ew-d)

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