From af6960a7c25a5cd36780116033b58550e061b166 Mon Sep 17 00:00:00 2001
From: keiichi <keiichi>
Date: Thu, 9 Dec 1999 07:08:51 +0000
Subject: [PATCH] (gnus-bbdb/split-mail): New implementation, and supports
 crosspost. (gnus-bbdb/split-mail-1): New function.

---
 lisp/gnus-bbdb.el |   92 ++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 63 insertions(+), 29 deletions(-)

diff --git a/lisp/gnus-bbdb.el b/lisp/gnus-bbdb.el
index a946d96..3b254dd 100644
--- a/lisp/gnus-bbdb.el
+++ b/lisp/gnus-bbdb.el
@@ -29,6 +29,7 @@
 ;;; Code:
 
 (require 'bbdb)
+(require 'bbdb-com)
 (require 'gnus)
 (require 'std11)
 (eval-when-compile
@@ -145,37 +146,70 @@ displaying the record corresponding to the sender of the current message."
       record)))
 
 ;;;###autoload
-(defun gnus-bbdb/split-mail (header-filed bbdb-field &optional regexp group)
+(defun gnus-bbdb/split-mail (header-field bbdb-field
+					  &optional regexp group)
   "Mail split method for `nnmail-split-fancy'.
-HEADER-FILED is regexp of mail header field name for gathering mail
-addresses. BBDB-FIELD is field name of BBDB.
-Optional argument REGEXP is regexp of matching BBDB-FIELD value.
-If REGEXP is nil or not specified, then all BBDB-FIELD value is match.
-If GROUP is nil or not specified, then use BBDB-FIELD value as group
-name. Otherwise use GROUP."
-  (or regexp (setq regexp ""))
-  (let ((pat (concat "\\(" header-filed "\\)" ":[ \t]"))
-	rest prop answer)
-    (goto-char (point-min))
+HEADER-FIELED is a regexp or list of regexps as mail header field name
+for gathering mail addresses.  If HEADER-FIELED is a string, then it's
+used for just matching pattern.  If HEADER-FIELED is a list of strings,
+then these strings have priorities in the order.
+
+BBDB-FIELD is field name of BBDB.
+Optional argument REGEXP is regexp string for matching BBDB-FIELD value.
+If REGEXP is nil or not specified, then all BBDB-FIELD value is matched.
+
+If GROUP is nil or not specified, then BBDB-FIELD value is returned as
+group name.  If GROUP is a symbol `&', then list of all matcing group's
+BBDB-FEILD values is returned.  Otherwise, GROUP is returned."
+  (if (listp header-field)
+      (if (eq group '&)
+	  (gnus-bbdb/split-mail (mapconcat 'identity header-field "\\|")
+				bbdb-field regexp group)
+	(let (rest)
+	  (while (and header-field
+		      (null (setq rest (gnus-bbdb/split-mail
+					(car header-field) bbdb-field
+					regexp group))))
+	    (setq header-field (cdr header-field)))
+	  rest))
+    (let ((pat (concat "^\\(" header-field "\\):[ \t]"))
+	  header-values)
+      (goto-char (point-min))
+      (while (re-search-forward pat nil t)
+	(setq header-values (cons (buffer-substring (point)
+						(std11-field-end))
+				  header-values)))
+      (let ((address-regexp
+	     (mapconcat
+	      (lambda (lal)
+		(regexp-quote (std11-address-string lal)))
+	      (apply 'nconc
+		     (mapcar #'std11-parse-addresses-string
+			     header-values))
+	      "\\|")))
+	(unless (zerop (length address-regexp))
+	  (gnus-bbdb/split-mail-1 address-regexp bbdb-field regexp group))))))
+
+(defun gnus-bbdb/split-mail-1 (address-regexp bbdb-field regexp group)
+  (let ((records (bbdb-search (bbdb-records) nil nil address-regexp))
+	prop rest)
+    (or regexp (setq regexp ""))
     (catch 'done
-      (while (< (point) (point-max))
-	(when (looking-at pat)
-	  (mapcar 
-	   (lambda (lal)
-	     (condition-case nil
-		 (let ((prop (bbdb-record-getprop
-			      (bbdb-search-simple nil
-						  (std11-address-string lal))
-			      bbdb-field)))
-		   (and (string-match regexp prop)
-			(throw 'done (or group prop))))
-	       (error nil)
-	       ))
-	   (std11-parse-addresses-string (buffer-substring (match-end 0)
-							   (std11-field-end)))
-	   ))
-	(forward-line)
-	))))
+      (cond
+       ((eq group '&)
+	(while records
+	  (when (and (setq prop (bbdb-record-getprop (car records) bbdb-field))
+		     (string-match regexp prop)
+		     (not (member prop rest)))
+	    (setq rest (cons prop rest)))
+	  (setq records (cdr records)))
+	(throw 'done (when rest (cons '& rest))))
+       (t
+	(while records
+	  (when (and (setq prop (bbdb-record-getprop (car records) bbdb-field))
+		     (string-match regexp prop))
+	    (throw 'done (or group prop)))
+	  (setq records (cdr records))))))))
 
 ;;
 ;; Announcing BBDB entries in the summary buffer
-- 
1.7.10.4