;;; rmail-mime.el --- Add MIME handling facility to RMAIL

;; Copyright (C) 2001 Free Software Foundation, Inc.

;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word

;; This file is part of SEMI (Setting for Emacs MIME Interfaces).

;; 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 GNU Emacs; 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 'mime-view)

(defun rmail-decode-header (decoded-buffer original-buffer start end)
  (set-buffer (get-buffer-create decoded-buffer))
  (erase-buffer)
  (insert-buffer-substring original-buffer start end)
  (mime-decode-header-in-buffer rmail-enable-mime))

(defun rmail-decode-mime-message (decoded-buffer original-buffer msg)
  (save-excursion
    (set-buffer original-buffer)
    (save-restriction
      (narrow-to-region (rmail-msgbeg msg)
			(rmail-msgend msg))
      (setq mime-message-structure
	    (mime-open-entity 'babyl original-buffer))
      (mime-display-message mime-message-structure decoded-buffer)))
  (set-buffer decoded-buffer))

(defun rmail-view-kill-rmail-buffer ()
  (if rmail-buffer (kill-buffer rmail-buffer)))

(defvar rmail-view-mode-map nil)

(defun rmail-show-mime-message ()
  (let ((abuf (current-buffer))
	(buf-name (concat (buffer-name) "-view"))
	buf win)
    (narrow-to-region (rmail-msgbeg rmail-current-message)
		      (rmail-msgend rmail-current-message))
    (setq mime-message-structure
	  (mime-open-entity 'babyl abuf))
    (set-buffer (mime-display-message mime-message-structure
				      buf-name nil
				      nil nil rmail-view-mode-map))
    (setq buf (current-buffer))
    (make-local-variable 'font-lock-defaults)
    (setq font-lock-defaults
	  '(rmail-font-lock-keywords
	    t nil nil nil
	    (font-lock-maximum-size . nil)
	    (font-lock-fontify-buffer-function
	     . rmail-fontify-buffer-function)
	    (font-lock-unfontify-buffer-function
	     . rmail-unfontify-buffer-function)
	    (font-lock-inhibit-thing-lock
	     . (lazy-lock-mode fast-lock-mode))))
    (make-local-variable 'rmail-buffer)
    (setq rmail-buffer abuf)
    (make-local-variable 'rmail-view-buffer)
    (setq rmail-view-buffer (current-buffer))
    (make-local-variable 'rmail-summary-buffer)
    (setq rmail-summary-buffer
	  (with-current-buffer rmail-buffer
	    rmail-summary-buffer))
    (make-local-variable 'rmail-current-message)
    (setq rmail-current-message
	  (with-current-buffer rmail-buffer
	    rmail-current-message))
    (make-local-variable 'kill-buffer-hook)
    (add-hook 'kill-buffer-hook 'rmail-view-kill-rmail-buffer)
    (make-local-variable 'revert-buffer-function)
    (setq revert-buffer-function 'rmail-revert)
    (let ((mode-line
	   (with-current-buffer abuf
	     (setq rmail-view-buffer buf)
	     mode-line-process)))
      (setq mode-line-process mode-line))
    (if (and (setq win (get-buffer-window abuf))
	     buf)
	(set-window-buffer win buf))
    (bury-buffer rmail-buffer)
    (run-hooks 'rmail-show-mime-message-hook)))

(defun rmail-insert-mime-forwarded-message (forward-buffer)
  (insert (mime-make-tag "message" "rfc822"))
  (insert "\n")
  (mime-insert-entity (with-current-buffer forward-buffer
			mime-message-structure)))

(defun rmail-insert-mime-resent-message (forward-buffer)
  (mime-insert-entity (with-current-buffer forward-buffer
			mime-message-structure)))

(defun rmail-enable-mime ()
  (interactive)
  (setq rmail-enable-mime t)
  (rmail-show-message))

(defun rmail-disable-mime ()
  (interactive)
  (let ((buf rmail-buffer))
    (when rmail-enable-mime
      (remove-hook 'kill-buffer-hook 'rmail-view-kill-rmail-buffer)
      (set-window-buffer (selected-window) buf)
      (kill-buffer rmail-view-buffer))
    (set-buffer buf))
  (setq rmail-enable-mime nil
	rmail-view-buffer (current-buffer))
  (rmail-show-message))

(defun rmail-search-mime-message (msg regexp)
  "Search the message of number MSG for REGEXP.
If the search succeeds, return non-nil.  Otherwise, return nil."
  (save-excursion
    (rmail-decode-mime-message " *RMAIL-temp-VIEW*" (current-buffer) msg)
    (goto-char (point-min))
    (prog1 (re-search-forward regexp nil t)
      (kill-buffer " *RMAIL-temp-VIEW*"))))

(defun rmail-search-mime-header (msg regexp limit)
  "Search the message header of number MSG for REGEXP.
The current point is the beginninf of header,
and LIMIT is the end position of header.
If the search succeeds, return non-nil.  Otherwise, return nil."
  (save-excursion
    (rmail-decode-header " *RMAIL-temp-VIEW*" (current-buffer) (point) limit)
    (goto-char (point-min))
    (prog1 (re-search-forward regexp nil t)
      (kill-buffer " *RMAIL-temp-VIEW*"))))

(set-alist 'mime-raw-representation-type-alist 'rmail-mode
	   (if rmail-enable-mime
	       'binary
	     'cooked))

(set-alist 'mime-preview-over-to-previous-method-alist
	   'rmail-mode
	   (function
	    (lambda ()
	      (message "Beginning of buffer")
	      ;; (rmail-previous-undeleted-message 1)
	      )))

(set-alist 'mime-preview-over-to-next-method-alist
	   'rmail-mode
	   (function
	    (lambda ()
	      (message "End of buffer")
	      ;; (rmail-next-undeleted-message 1)
	      )))

(set-alist 'mime-preview-quitting-method-alist 'rmail-mode #'rmail-quit)

;; Override values defined in rmail.
(eval-after-load "rmail"
  '(progn
     (define-key rmail-mode-map "v" 'rmail-enable-mime)
     (setq rmail-show-mime-function
	   (function rmail-show-mime-message)
	   rmail-insert-mime-forwarded-message-function
	   (function rmail-insert-mime-forwarded-message)
	   rmail-insert-mime-resent-message-function
	   (function rmail-insert-mime-resent-message)
	   rmail-search-mime-message-function
	   (function rmail-search-mime-message)
	   rmail-search-mime-header-function
	   (function rmail-search-mime-header))
     (unless rmail-view-mode-map
       (setq rmail-view-mode-map (mime-view-define-keymap rmail-mode-map))
       (define-key rmail-view-mode-map
	 "p" (function rmail-previous-undeleted-message))
       (define-key rmail-view-mode-map
	 "n" (function rmail-next-undeleted-message))
       (define-key rmail-view-mode-map
	 "u" (function rmail-undelete-previous-message))
       (define-key rmail-view-mode-map
	 "a" (function rmail-add-label))
       (define-key rmail-view-mode-map
	 "\C-c\C-c" (function rmail-disable-mime)))))

;; Override values defined in rmailsum.
(eval-after-load "rmailsum"
  '(setq rmail-summary-line-decoder
	 (function
	  (lambda (string)
	    (eword-decode-string
	     (decode-coding-string string 'undecided))))))

;; Override values defined in sendmail.
(eval-after-load "sendmail"
  '(progn
     (add-hook 'mail-setup-hook 'turn-on-mime-edit)
     (add-hook 'mail-send-hook 'mime-edit-maybe-translate)))

(provide 'rmail-mime)