(defun my-mh-folder-from-address ()
  "Determine folder name from address.
Takes the address in the From: header field, and returns its corresponding
alias from the user's personal aliases file. Returns nil if the address
was not found."
  (require 'rfc822)				; for the rfc822 functions
  (search-forward-regexp "^From: \\(.*\\)")	; grab contents of header field
  (setq addr (car (rfc822-addresses		; get address from header field
                   (buffer-substring (match-beginning 1)
                                     (match-end 1)))))
  (save-excursion				; save state
    (let ((buffer (get-buffer-create " *temp*")) ; set local variables
          folder)
      (set-buffer buffer)			; jump to temporary buffer
      (unwind-protect			; run kill-buffer when done or on error
          (progn			; function grouping construct
            (insert-file-contents (expand-file-name "aliases" mh-user-path))
            (goto-char (point-min))	; grab aliases file and go to beginning
            (setq folder
                  ;; Search for the given address, even commented-out
                  ;; addresses are found!  The function
                  ;; search-forward-regexp sets values that are later
                  ;; used by match-beginning and match-end.
                  (if (search-forward-regexp (format "^;*\\(.*\\):.*%s"
                                                     addr) nil t)
                      ;; NOTE WELL: this is what the return value
                      ;; looks like.  You can modify the format string
                      ;; to match your own Mail hierarchy.
                      (format "+%s" (buffer-substring (match-beginning 1)
                                                      (match-end 1))))))
        (kill-buffer buffer))		; get rid of our temporary buffer
      folder)))				; function's return value

(setq mh-default-folder-for-message-function 'my-mh-folder-from-address)
