Re: gather from message send addresses

Hello,

Randy Bush wrote:
[...]
> i made no progress on this.  weak fu and overwhelmed at work.
> 
> have you made any?
to be honest, I haven't looked into it. Well, not much at least. As a
starting point I cannibalised bbdb-wl.el and ended with that:


(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)


That grabs the addresses from the headers noted in
bbdb-message-headers, filters out the addresses matching
bbdb-user-mail-address-re and put the remaining addresses into bbdb.

I'm not sure what the caaddr of an item is in the original solution.
Maybe an address without a name? In our case the inner list consists
of only two elements, the name and the email address. That means that
the comparison is always false and delete-if doesn't filter any items.
That should be changed.

The original solution uses bbdb-get-only-first-address-p, which again
I don't know anything about. Maybe that result is equivalent to only
process the car of bbdb-wl-get-addresses' result?

Regards
hmw