;;; 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)
    (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-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 beg end regexp)
  "Search the message header of number MSG for REGEXP.
If the search succeeds, return non-nil.  Otherwise, return nil."
  (save-excursion
    (rmail-decode-header " *RMAIL-temp-VIEW*"
			 (current-buffer)
			 beg end)
    (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))
     (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)