Bbdb Based Refiling Hints

I use the BigBrotherDataBase to automatically maintain an addressbook. The following code gives MH-E the ability to remember the folder where previous email from the same author has been refiled. That folder is presented as the default folder for refiling. It works quite well since I usually archive all email from the same person in a single folder.

The code assumes that you are using MH-E from CVS. For released versions of MH-E, you will need to tweak the defadvice forms to use mh-interactive-msg-or-seq instead of mh-interactive-range.

(require 'mh-e)

;;; BBDB Refiling...
(defun bw-find-from-address ()
  "Find address from From: field."
  (require 'rfc822)                     ; for the rfc822 functions
  (when (search-forward-regexp "^From: \\(.*\\)" nil t)
    ;; Grab header field contents
    (car (rfc822-addresses (buffer-substring-no-properties
                            (match-beginning 1) (match-end 1))))))

(defun sd-mh-folder-from-address ()
  "Determine folder name from address.
Take the address in the From: field and find BBDB entry corresponding to it.
Use mhe-folders field, if present, as default and add new choice if not already
present to the mhe-refile field."
  (save-excursion
    (when (mh-mark-active-p t) (goto-char (region-beginning)))
    (let* ((case-fold-search t)
           (msg (mh-get-msg-num nil))
           (msg-file (mh-msg-filename msg mh-current-folder))
           (addr (and msg-file
                      (with-temp-buffer
                        (insert-file-contents msg-file)
                        (bw-find-from-address))))
           (record (and addr (bbdb-annotate-message-sender addr nil t t)))
           (string (and record (bbdb-record-getprop record 'mhe-folders)))
           (candidates (and string (car (read-from-string string))))
           (folder (mh-prompt-for-folder "Destination" (car candidates) t)))
      (when (and record (not (eq (car candidates) folder)))
        (bbdb-record-putprop record 'mhe-folders
                             (prin1-to-string 
                              (cons folder (remove folder candidates)))))
      (intern folder))))

(defadvice mh-refile-msg (before sd-mh-refile-folder activate)
  "Use BBDB to prompt for folder."
  (interactive
   (list (mh-interactive-range "Refile") (sd-mh-folder-from-address))))

(defadvice mh-thread-refile (before sd-mh-refile-folder activate)
  "Use BBDB for folder prompt."
  (interactive (list (sd-mh-folder-from-address))))