Re: gather from message send addresses

finally giving this a try.  wish me luck.

randy

> (require 'bbdb)
> 
> (defvar bbdb-wl-canonicalize-full-name-function
>   #'bbdb-wl-canonicalize-spaces-and-dots
>   "Way to canonicalize full name.")
> 
> (defun bbdb-wl-canonicalize-spaces-and-dots (string)
>   (while (and string (string-match "  +\\|[\f\t\n\r\v]+\\|\\." string))
>     (setq string (replace-match " " nil t string)))
>   (and string (string-match "^ " string)
>        (setq string (replace-match "" nil t string)))
>   string)
> 
> 
> (defun bbdb-wl-get-addresses (&optional only-first-address)
>   "Return real name and email address of sender respectively recipients.
> If an address matches `bbdb-user-mail-address-re' it will be ignored.
> The headers to search can be configured by `bbdb-message-headers'."
>   (save-excursion
>     (save-restriction
>       (std11-narrow-to-header)
>       (let ((headers bbdb-message-headers)
> 	    (uninteresting-senders bbdb-user-mail-address-re)
> 	    addrlist header structures structure fn ad
> 	    header-type header-fields header-content)
> 	(while headers
> 	  (setq header-type (caar headers)
> 		header-fields (cdar headers))
> 	  (while header-fields
> 	    (setq header-content (std11-fetch-field (car header-fields)))
> 	    (when header-content
> 	      (setq structures (std11-parse-addresses-string
> 				(std11-unfold-string header-content)))
> 	      (while (and (setq structure (car structures))
> 			  (eq (car structure) 'mailbox))
>                 (setq fn (std11-full-name-string structure)
> 		      fn (and fn
> 			      (with-temp-buffer ; to keep raw buffer unibyte.
> 				(set-buffer-multibyte
> 				 default-enable-multibyte-characters)
> 				(eword-decode-string
> 				 (decode-mime-charset-string
> 				  fn wl-mime-charset))))
> 		      fn (funcall bbdb-wl-canonicalize-full-name-function fn)
> 		      ad (std11-address-string structure))
> 		;; ignore uninteresting addresses, this is kinda gross!
> 		(when (or (not (stringp uninteresting-senders))
> 			  (not
> 			   (or
> 			    (and fn
> 				 (string-match uninteresting-senders fn))
> 			    (and ad
> 				 (string-match uninteresting-senders ad)))))
> 		  (add-to-list 'addrlist (list fn ad)))
> 		(if (and only-first-address addrlist)
> 		    (setq structures nil headers nil)
> 		  (setq structures (cdr structures)))))
> 	    (setq header-fields (cdr header-fields)))
> 	  (setq headers (cdr headers)))
> 	(nreverse addrlist)))))
> 
> 
> (defun zzz-bbdb-mail-send-function ()
>   (bbdb-update-records
>    (delete-if (lambda (item)
> 		(string= "" (caaddr item)))
> 	      (bbdb-wl-get-addresses))
>    t t))
> (add-hook 'mail-send-hook 'zzz-bbdb-mail-send-function)