* lisp/gnus-bbdb.el: Sync up with Nana-gnus 7 for supporting

`gnus-bbdb/split-mail'.
* README-gnus-bbdb.ja: Ditto.

diff --git a/README-gnus-bbdb.ja b/README-gnus-bbdb.ja
index 18f3e9b..393256e 100644 (file)
--- a/README-gnus-bbdb.ja
+++ b/README-gnus-bbdb.ja
@@ -102,3 +102,37 @@ FLIM \e$B$G$O\e(B quote \e$B$5$l$?\e(B eword encoded word \e$B$O\e(B decode \e$B$5$l$^$
 ------ cut here ------ cut here ------ cut here ------ cut here ------
 
 ---
+gnus-bbdb/split-mail()
+
+nnmail-split-fancy \e$B$G;HMQ$9$k$?$a$N4X?t$G$9!#<!$N$h$&$K;HMQ$7$F$/$@$5$$!#\e(B
+
+(setq nnmail-split-methods 'nnmail-split-fancy
+      nnmail-split-fancy
+      '(|
+        .....
+*1      (: gnus-bbdb/split-mail "from\\|to\\|cc"
+           'company "foo" "foo-group") 
+        .....
+*2      (: gnus-bbdb/split-mail "from\\|to\\|cc" 'company "^bar")
+        .....
+*3      (: gnus-bbdb/split-mail "from\\|to\\|cc" 'group)
+        .....
+*4      (: gnus-bbdb/split-mail "from\\|to\\|cc" 'note "my friend"
+          '(|
+             .....
+        .....
+        ))
+
+*1 : From, To, Cc \e$B$$$:$l$+$N%X%C%@!<!&%U%#!<%k%I$K4^$^$l$k%a%$%k!&%"%I\e(B
+     \e$B%l%9$N$&$A\e(B BBDB \e$B$N\e(B `company' \e$B%U%#!<%k%I$K\e(B `foo' \e$B$,4^$^$l$k>l9g!"\e(B
+     `foo-group' \e$B$K?6$jJ,$1$^$9!#\e(B
+
+*2 : `company' \e$B%U%#!<%k%I$,\e(B `bar' \e$B$G;O$^$C$F$$$k>l9g!"\e(B`company' \e$B%U%#!<\e(B
+     \e$B%k%I$NFbMF$r$=$N$^$^%0%k!<%WL>$H$7$F;HMQ$7!"?6$jJ,$1$^$9!#\e(B
+
+*3 : `group' \e$B%U%#!<%k%I$,$"$k>l9g!"\e(B`group' \e$B%U%#!<%k%I$NFbMF$r$=$N$^$^\e(B
+     \e$B%0%k!<%WL>$H$7$F;HMQ$7!"?6$jJ,$1$^$9!#\e(B
+
+*4 : `note' \e$B%U%#!<%k%I$K\e(B `my friend' \e$B$,4^$^$l$k>l9g!"$=$N8e$m$K;XDj$5\e(B
+     \e$B$l$?5,B'$G?6$jJ,$1$^$9!#$3$N5,B'$N5-=RJ}K!$O!"DL>o$N\e(B
+     `nnmail-split-fancy' \e$B$G$N5-=RJ}K!$HF1$8$b$N$G$9!#\e(B

diff --git a/lisp/gnus-bbdb.el b/lisp/gnus-bbdb.el
index 93da055..d6e8165 100644 (file)
--- a/lisp/gnus-bbdb.el
+++ b/lisp/gnus-bbdb.el
@@ -3,7 +3,7 @@
 ;; Copyright (c) 1991,1992,1993 Jamie Zawinski <jwz@netscape.com>.
 ;; Copyright (C) 1995,1996,1997 Shuhei KOBAYASHI
 ;; Copyright (C) 1997,1998 MORIOKA Tomohiko
-;; Copyright (C) 1998 Keiichi Suzuki <keiichi@nanap.org>
+;; Copyright (C) 1998,1999 Keiichi Suzuki <keiichi@nanap.org>
 
 ;; Author: Keiichi Suzuki <keiichi@nanap.org>
 ;; Author: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
@@ -29,9 +29,11 @@
 ;;; Code:
 
 (require 'bbdb)
+(require 'bbdb-com)
 (require 'gnus)
 (require 'std11)
 (eval-when-compile
+  (defvar bbdb-pop-up-elided-display)  ; default unbound.
   (require 'gnus-win))
 
 (defvar gnus-bbdb/decode-field-body-function 'nnheader-decode-field-body
@@ -53,8 +55,8 @@ the user confirms the creation."
       (gnus-bbdb/pop-up-bbdb-buffer offer-to-create)
     (save-excursion
       (let (from)
+       (set-buffer gnus-original-article-buffer)
        (save-restriction
-         (set-buffer gnus-original-article-buffer)
          (widen)
          (narrow-to-region (point-min)
                            (progn (goto-char (point-min))
@@ -78,7 +80,7 @@ the user confirms the creation."
                                        (or (bbdb-invoke-hook-for-value
                                             bbdb/news-auto-create-p)
                                            offer-to-create)
-                                       offer-to-create)))))))
+                                       offer-to-create)))))) )
 
 ;;;###autoload
 (defun gnus-bbdb/annotate-sender (string &optional replace)
@@ -110,8 +112,6 @@ This buffer will be in bbdb-mode, with associated keybindings."
        (bbdb-display-records (list record))
        (error "unperson"))))
 
-;; Avoid byte-compile warning.
-(defvar bbdb-pop-up-elided-display)
 
 (defun gnus-bbdb/pop-up-bbdb-buffer (&optional offer-to-create)
   "Make the *BBDB* buffer be displayed along with the GNUS windows,
@@ -146,6 +146,74 @@ displaying the record corresponding to the sender of the current message."
       (set-buffer b)
       record)))
 
+;;;###autoload
+(defun gnus-bbdb/split-mail (header-field bbdb-field
+                                         &optional regexp group)
+  "Mail split method for `nnmail-split-fancy'.
+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
+      (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 (or (null bbdb-field) 
+                   (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
 ;;