Copy from Nana-gnus 6.13.

diff --git a/lisp/gnus-bbdb.el b/lisp/gnus-bbdb.el
index 10b1acc..be73903 100644 (file)
--- a/lisp/gnus-bbdb.el
+++ b/lisp/gnus-bbdb.el
@@ -1,15 +1,15 @@
-;; gnus-bbdb.el --- Interface to Semi-gnus.
+;; gnus-bbdb.el --- Interface to after Nana-gnus version 6.10.2.
 
 ;; 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 <kei-suzu@mail.wbs.ne.jp>
+;; Copyright (C) 1998,1999 Keiichi Suzuki <keiichi@nanap.org>
 
-;; Author: Keiichi Suzuki <kei-suzu@mail.wbs.ne.jp>
+;; Author: Keiichi Suzuki <keiichi@nanap.org>
 ;; Author: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
 ;; Keywords: BBDB, MIME, multimedia, multilingual, mail, news
 
-;; This file is part of Semi-gnus.
+;; This file is part of Nana-gnus.
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -29,18 +29,20 @@
 ;;; 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 'eword-decode-string
+(defvar gnus-bbdb/decode-field-body-function 'nnheader-decode-field-body
   "*Field body decoder.")
 
 (defmacro gnus-bbdb/decode-field-body (field-body field-name)
   `(or (and (functionp gnus-bbdb/decode-field-body-function)
            (funcall gnus-bbdb/decode-field-body-function
-                    ,field-body))
+                    ,field-body ,field-name))
        ,field-body))
 
 ;;;###autoload
@@ -144,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
 ;;