;;; niko-bbdb-split.el --- Various ways to split mails from BBBD

;; Authors: Nicolas Kowalski <Nicolas.Kowalski@imag.fr>,
;;          Matthieu Moy <Matthieu.Moy@imag.fr>
;; Keywords: mail

;; This file is free software; you can redistribute it and/or modify
;; it with no restriction,

;;; Commentary:

;; Automatic generation of ~/.procmailrc file and/or
;; gnus-move-split-methods from the BBDB database.

;;; Code:

;; Insert the following lines in your configuration files
;; (niko/bbdb2procmailrc-initialize)
;; (niko/bbdb2split-initialize)
;; There is very few chance that the default configuration work for
;; you, so, M-x customize-group RET niko-bbdb-split RET will help you.

;;; ChangeLog:
;; Version 1.2: September 30th, 2004
;;   - Generation of the default rules for procmail in a different
;;     file (optional)
;;
;; Version 1.1: September 07th, 2004 - bugfixes.
;;   - The list of arguments of niko/bbdb2split{-initialize} was
;;     mixed up with "(interactive)".
;;   - niko/bbdb2split returned the wrong value.
;;
;; Version 1.0: April 04, 2004 - initial version
;;

;;
;; procmailrc generation
;;

(eval-and-compile
  (require 'gnus-sum)
  (require 'bbdb)
  )

(defgroup niko-bbdb-split nil
  "Splitting mails from BBDB")

(defgroup niko-bbdb2procmail nil
  "Generation of a portion of ~/.procmailrc from your BBDB"
  :group 'niko-bbdb-split)

(defcustom niko/bbdb2procmailrc-field 'gnus-private
  "Field of the BBDB entries used for the condition of the procmail
rule."
  :type 'symbol
  :group 'niko-bbdb2procmail)

(defcustom niko/bbdb2procmailrc-filename "~/.procmailrc-bbdb"
  "Name of the generated ~/.procmailrc. Usually, you will want to
put something like \"~/.procmailrc-bbdb\" here, and put a
\"INCLUDERC=$HOME/procmailrc-bbdb\" in your ~/.procmailrc file, or
you can chose to generate your whole \"~/.procmailrc\"."
  :type 'string
  :group 'niko-bbdb2procmail)

(defcustom niko/bbdb2procmailrc-default-rule-filename "~/.procmailrc-bbdb-default"
  "Name of the generated ~/.procmailrc containing the \"default\" rule
 (the rule applicable to everyone in your address book without a
gnus-private field. Usually, you will want to include this file at the
end of your ~/.procmailrc file. You can choose the same filename here
and for `niko/bbdb2procmailrc-filename' (or just put nil here) to have
all rules generated in the same file."
  :type 'string
  :group 'niko-bbdb2procmail)

(defcustom niko/bbdb2procmailrc-rule-header ":0"
  "Header of the generated procmail rule. Should be \":0\" (no lock
file) or \":0:\" (procmail will use a lock file, necessary when it
writes directly to a folder)."
  :type 'string
  :group 'niko-bbdb2procmail)

(defcustom niko/bbdb2procmailrc-rule-precond ""
  "If you want to add a precondition to the rule. Should be of the
form \"* Header: .*value\\n\"."
  :type 'string
  :group 'niko-bbdb2procmail)

(defcustom niko/bbdb2procmailrc-folder-prefix "| dmail \"+"
  "Prefix for the action of the rule."
  :type 'string
  :group 'niko-bbdb2procmail)

(defcustom niko/bbdb2procmailrc-folder-suffix "\""
  "Suffix for the action of the rule."
  :type 'string
  :group 'niko-bbdb2procmail)

(defcustom niko/bbdb2procmailrc-file-header
  "####-*- mode: shell-script -*-
### Warning !!! Generated file, do not edit !!! \n\n"
  "header inserted on top of the generated file"
  :type 'string
  :group 'niko-bbdb2procmail)

(defcustom niko/bbdb2procmailrc-mail-header "^From: .*"
  "* Procmail syntax regular expression for the field on which sorting
should be done. Usually, \"^From.*\"."
  :type 'string
  :group 'niko-bbdb2procmail)

(defcustom niko/bbdb2procmailrc-create-default t
  "* Wether a default rule should be created. The default rule is in
the form

:0
* From: <anybody in your .bbdb>
`niko/bbdb2procmailrc-default-box'"
  :type 'bool
  :group 'niko-bbdb2procmail)

(defcustom niko/bbdb2procmailrc-default-box "perso"
  "* Name of the mailbox where mail should be delivered for people in
.bbdb"
  :type 'string
  :group 'niko-bbdb2procmail)

(defun niko/bbdb2procmailrc-quote-email (email)
  (replace-regexp-in-string "\\." "\\\\." email))

;;;###autoload
(defun niko/bbdb2procmailrc ()
  "Generates a .procmailrc file from your BBDB database, based on the
field `niko/bbdb2procmailrc-field' or each record. The filename is
specified by the variable `niko/bbdb2procmailrc-field', designed to be
included in your ~/.procmailrc with
\"INCLUDERC=${HOME}/.procmailrc-bbdb\" or similar, most probably at
the end of your ~/.procmailrc.

The generated rules are in the form
`niko/bbdb2procmailrc-rule-header'
`niko/bbdb2procmailrc-rule-precond'
* `niko/bbdb2procmailrc-mail-header'(regexp.matching@email|address.of.the@person.com)
`niko/bbdb2procmailrc-folder-prefix'folder`niko/bbdb2procmailrc-folder-suffix'
"
  (interactive)
  (let* ((records (bbdb-records))
         (default-regexp "")
         (default-rule-buffer)
         (default-rule-in-other-buffer
           (and niko/bbdb2procmailrc-default-rule-filename
                (not (string= niko/bbdb2procmailrc-default-rule-filename
                              niko/bbdb2procmailrc-filename)))))
    (with-temp-buffer
      (setq default-rule-buffer
            (if default-rule-in-other-buffer
                (progn
                  (with-current-buffer (get-buffer-create (generate-new-buffer-name
                                                           " *temp*"))
                    (insert niko/bbdb2procmailrc-file-header)
                    (current-buffer)))
              (current-buffer)))
      (insert niko/bbdb2procmailrc-file-header)
      (while records
	(when (car records)
	  (let* ((r (car records))
		 (f (bbdb-record-getprop r niko/bbdb2procmailrc-field))
		 (n (bbdb-record-net r)))
	    (when (and n (or f niko/bbdb2procmailrc-create-default))
              (with-current-buffer
                  (if f (current-buffer) default-rule-buffer)
                (insert "# " (bbdb-record-name r) "\n")
                (unless f
                  (insert "# Default\n"))
                (insert niko/bbdb2procmailrc-rule-header "\n"
                        niko/bbdb2procmailrc-rule-precond)
                (insert "* " niko/bbdb2procmailrc-mail-header)
                (if (cdr n)
                    (progn
                      (insert "(")
                      (mapcar #'(lambda (x)
                                  (insert
                                   (niko/bbdb2procmailrc-quote-email x)
                                   "|")) n)
                      (backward-delete-char 1) ; One `|' removed.
                      (insert ")")
                      )
                  (insert (niko/bbdb2procmailrc-quote-email (car n))))
                (insert "\n" niko/bbdb2procmailrc-folder-prefix
                        (or f niko/bbdb2procmailrc-default-box)
                        niko/bbdb2procmailrc-folder-suffix "\n\n"))
              )))
	(setq records (cdr records)))
      (write-file niko/bbdb2procmailrc-filename nil)
      (when default-rule-in-other-buffer
        (with-current-buffer default-rule-buffer
          (write-file niko/bbdb2procmailrc-default-rule-filename)))
      )
    (kill-buffer default-rule-buffer)
    )
  )

;;;###autoload
(defun niko/bbdb2procmailrc-initialize () (interactive)
  "Call this function to have the `niko/bbdb2procmailrc-filename'
whenever the *BBDB* buffer is saved."
  (niko/bbdb2procmailrc)
  (defadvice bbdb-save-db
    (after niko-bbdb-save activate)
    (niko/bbdb2procmailrc))
  )


;;
;; gnus-move-split-methods generation
;;

(defgroup niko-bbdb2split nil
  "Generation of a value for the variable gnus-move-split-methods"
  :group 'niko-bbdb-split)

(defcustom niko/bbdb2split-folder-prefix "nnimap:"
  "Prefix for the destination folder name. Will be prepended to the
content of the field 'gnus-split in your BBDB."
  :type 'string
  :group 'niko-bbdb2split)

(defcustom niko/bbdb2split-folder-suffix ""
  "Suffix for the destination folder name. Will be appended to the
content of the field 'gnus-split in your BBDB."
  :type 'string
  :group 'niko-bbdb2split)

(defcustom niko/bbdb2split-fields-regexp "^\\(From\\|To\\|Cc\\):.*"
  "Emacs regexp defining the field(s) on which you want to split"
  :type 'string
  :group 'niko-bbdb2split)

(defcustom niko/bbdb2split-field 'gnus-split
  "Name of the field of the BBDB records containing the name of the
target mailbox"
  :type 'symbol
  :group 'niko-bbdb2split)

(defun niko/bbdb2split-internal ()
  "Returns a suitable value for `gnus-move-split-methods', based on
the field `niko/bbdb2split-field' of the records in your BBDB"
  (let ((result nil)
        (records (bbdb-records)))
    (while records
      (let* ((r (car records))
             (f (bbdb-record-getprop r niko/bbdb2split-field))
             (n (bbdb-record-net r)))
        (when (and f n)
          (setq result
                (cons (list (concat niko/bbdb2split-fields-regexp
                                    (regexp-opt n))
                            (concat niko/bbdb2split-folder-prefix
                                    f
                                    niko/bbdb2split-folder-suffix))
                      result))))
      (setq records (cdr records)))
    result)
  )

;;;###autoload
(defun niko/bbdb2split ()
  "Sets the variable `gnus-move-split-methods' to the value computed
by `niko/bbdb2split-internal'. This means that after calling this
function, 'B m' will move the message to the mailbox specified by the
field `niko/bbdb2split-field'. You don't have to do so since
`niko/bbdb2split-initialize' calls it automatically whenever you save
your BBDB."
  (interactive)
  (setq gnus-move-split-methods (niko/bbdb2split-internal)))

;;;###autoload
(defun niko/bbdb2split-initialize ()
  "Call this function to have the variable `gnus-move-split-methods'
updated whenever the *BBDB* buffer is saved."
  (interactive)
  (defadvice bbdb-save-db
    (after niko-bbdb-save activate)
    (niko/bbdb2split))
  )


(provide 'niko-bbdb-split)
;;; niko-bbdb-split.el ends here