;;; wl-approve.el

;; Copyright (C) 2001 Kenichi OKADA <okada@opaopa.org>

;; Author: Kenichi OKADA <okada@opaopa.org>

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

;;; Commentary:

;; usage:
;;
;; (autoload 'wl-approve "wl-approve" nil t)

;;; Code:

(defvar wl-approve-delete-headers
  '("Path"
    "Return-Path"
    "X-UIDL"
    "NNTP-Posting-Host"
    "X-Trace"
    "X-Complaints-To"
    "NNTP-Posting-Date"
    "Xref"
    "Date-Received"
    "Received"
    "Posted"
    "Posting-Version"
    "Relay-Version"))

(defun wl-approve ()
  "Approve current message."
  (interactive)
  (let ((parent-folder (wl-summary-buffer-folder-name))
	(number (wl-summary-message-number))
	(folder wl-summary-buffer-elmo-folder))
    (if (null number)
	(message "No message.")
      (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
	    (delete-headers wl-approve-delete-headers)
	    buf-name file-name num wl-demo change-major-mode-hook)
    (if (not (elmo-folder-message-file-p draft-folder))
	(error "%s folder cannot be used for draft folder" wl-draft-folder))
    (setq num (elmo-max-of-list
	       (or (elmo-folder-list-messages draft-folder) '(0))))
    (setq num (+ 1 num))
    ;; To get unused buffer name.
    (while (get-buffer (concat wl-draft-folder "/" (int-to-string num)))
      (setq num (+ 1 num)))
    (setq buf-name (find-file-noselect
		    (setq file-name
			  (elmo-message-file-name
			   (wl-folder-get-elmo-folder wl-draft-folder)
			   num))))
    (if wl-draft-use-frame
	(switch-to-buffer-other-frame buf-name)
      (switch-to-buffer buf-name))
    (set-buffer buf-name)
    (if (not (string-match (regexp-quote wl-draft-folder)
			   (buffer-name)))
	(rename-buffer (concat wl-draft-folder "/" (int-to-string num))))
    (delete-other-windows)
    (auto-save-mode -1)
    (wl-draft-mode)
    (make-local-variable 'truncate-partial-width-windows)
    (setq truncate-partial-width-windows nil)
    (setq truncate-lines wl-draft-truncate-lines)
    (setq wl-sent-message-via nil)
    (setq wl-draft-parent-folder parent-folder)
    (setq wl-draft-buffer-file-name file-name)

    (make-variable-buffer-local 'wl-mail-send-pre-hook)
    (make-variable-buffer-local 'wl-news-send-pre-hook)
    (make-variable-buffer-local 'wl-draft-send-hook)
    (make-variable-buffer-local 'wl-draft-config-exec-hook)
    (setq wl-mail-send-pre-hook nil)
    (setq wl-news-send-pre-hook nil)
    (setq wl-draft-send-hook nil)
    (setq wl-draft-config-exec-hook nil)
    (setq wl-draft-config-exec-flag nil)

    (goto-char (point-min))
    (elmo-message-fetch folder
			number
			(elmo-make-fetch-strategy
			 'entire
			 t ; use cache
			 nil ; save cache (should `t'?)
			 nil)
			nil
			(current-buffer)
			'unread)
    (wl-approve-replace-header "To" "Approved")
    (goto-char (point-min))
    (or (re-search-forward "\n\n" nil t)
	(goto-char (point-max)))
    (goto-char (1- (point)))
    (kill-line)
    (setq delimline (point-marker))
    (save-restriction
      (while delete-headers
	(wl-draft-delete-field (car delete-headers) delimline)
	(setq delete-headers (cdr delete-headers)))
      (if (setq content-type
		(std11-field-body "content-type"))
	  (wl-draft-delete-field "content-type" delimline))
      (if (setq content-transfer-encoding
		(std11-field-body "content-transfer-encoding"))
	  (wl-draft-delete-field "content-transfer-encoding" delimline)))
    (when content-type
      (insert "Content-type: " content-type "\n"))
    (when content-transfer-encoding
      (insert "Content-Transfer-Encoding: " content-transfer-encoding "\n"))
    (if (or content-type content-transfer-encoding)
	(insert "\n"))
    (save-restriction
      (narrow-to-region delimline (point-max))
      (wl-draft-decode-message-in-buffer)
      (widen)
      (goto-char delimline)
      (put-text-property (point)
			 (progn
			   (insert mail-header-separator "\n")
			   (1- (point)))
			 'category 'mail-header-separator))
    (as-binary-output-file
     (write-region (point-min)(point-max) wl-draft-buffer-file-name
		   nil t))
    (wl-draft-editor-mode)
    (wl-draft-overload-functions)
    (wl-highlight-headers 'for-draft)
    (goto-char (point-min))))))

(defun wl-approve-replace-header (orig-header new-header)
  (save-excursion
    (save-restriction
      (let ((case-fold-search t))
	(goto-char (point-min))
	(if (re-search-forward (concat "^" (regexp-quote orig-header) ":") nil t)
	    (replace-match (concat new-header ":")))))))


(provide 'wl-approve)

;;; wl-approev.el ends here