;; wl-whitelist.el
;; Interactively manage a whitelist
;; (C) Copyright David Bremner <bremner@unb.ca> 2007
;;
;; 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.

(require 'wl-spam)
(provide 'wl-whitelist)

(defcustom wl-whitelist-fields 
  '(sender return-path from)
  "Header fields to collect addresses from"
  :group 'wl-whitelist)

(defconst wl-whitelist-standard-fields
  '(from cc))

(defcustom wl-whitelist-folder
  "%whitelist"
  "Folder to save whitelist addresses in")

(defcustom wl-whitelist-mark-action-list
  '(("W"
     whitelist
     nil
     wl-summary-register-temp-mark
     wl-summary-exec-action-whitelist
     nil
;;     wl-highlight-summary-whitelist-face
     "Mark messages to be whitelisted.")
    ("B"
     blacklist
     nil
     wl-summary-register-temp-mark
     wl-summary-exec-action-whitelist
     nil
;;     wl-highlight-summary-whitelist-face
     "Mark messages to be blacklisted."))

  "A variable to define Mark & Action for whitelisting.
Append this value to `wl-summary-mark-action-list' by `wl-whitelist-setup'.

See `wl-summary-mark-action-list' for the detail of element."
  :type '(repeat (list
		  (string :tag "Temporary mark")
		  (symbol :tag "Action name")
		  (symbol :tag "Argument function")
		  (symbol :tag "Set mark function")
		  (symbol :tag "Exec function")
		  (symbol :tag "Face symbol")
		  (string :tag "Document string")))
  :group 'wl-whitelist)


(defun wl-whitelist-setup ()
  (interactive)
  (dolist (field wl-whitelist-fields)
    (if (not (member field wl-whitelist-standard-fields))
	(add-to-list 'elmo-msgdb-extra-fields (symbol-name field))))
  (when wl-whitelist-mark-action-list
    (setq wl-summary-mark-action-list (append
				       wl-summary-mark-action-list
				       wl-whitelist-mark-action-list))
    (dolist (action wl-whitelist-mark-action-list)
      (setq wl-summary-reserve-mark-list
	    (cons (wl-summary-action-mark action)
		  wl-summary-reserve-mark-list))
      (setq wl-summary-skip-mark-list
	    (cons (wl-summary-action-mark action)
		  wl-summary-skip-mark-list))))
  (define-key  wl-summary-spam-map "w" 'wl-summary-whitelist)
  (define-key  wl-summary-spam-map "b" 'wl-summary-blacklist))

;; Whitelist marked messages
(defun wl-summary-exec-action-whitelist (mark-list)
  (save-excursion
    (let* ((count 0)
	   (length (length mark-list))
	   (mark-list-copy (copy-sequence mark-list))
	   (pos (point))
	   (failures 0))
	(dolist (mark-info mark-list-copy)
	  (message "Whitelisting...(%d/%d)"
		   (setq count (+ 1 count)) length)
	  (if (wl-whitelist-msg  mark-info)
	      (progn
		(wl-summary-unset-mark (car mark-info))
		(sit-for 0))
	    (incf failures))))
    (message "Whitelisting...done"))
  0)


(defun wl-whitelist-msg (mark-info)
  (save-excursion
    (let* ((number (car mark-info))
	   (type (cadr mark-info))
	  (addr-list (wl-whitelist-find-addresses number)))
      (dolist (addr addr-list)
	(wl-whitelist-append-to-folder wl-whitelist-folder addr type))))
    't)

(defun wl-whitelist-find-addresses (number)
  (let ((msg (elmo-message-entity wl-summary-buffer-elmo-folder number))
	(result nil)	 )
    (dolist (field wl-whitelist-fields result)
	(let ((val (elmo-message-entity-field msg field)))
	  (if val (let ((addr (cadr (std11-extract-address-components val))))
		    (add-to-list 'result addr)))))))

(defun wl-whitelist-append-to-folder (foldername from type)
  (let ((folder (wl-folder-get-elmo-folder foldername)))
    (progn 
      (wl-folder-confirm-existence folder)
      (with-temp-buffer 
	(goto-char (point-min))
	(insert "From: " from "\n")
	(insert "X-WL-Whitelist: " type "\n")
	(wl-draft-insert-date-field)
	(insert (concat "Message-ID: "
			(funcall wl-message-id-function)
			"\n"))
	(elmo-folder-append-buffer folder '(read))))))