T-gnus 6.14.4 (r01)

[elisp/gnus.git-] / lisp / gnus-bbdb.el

diff --git a/lisp/gnus-bbdb.el b/lisp/gnus-bbdb.el
index 08ee7a7..c00a253 100644 (file)
--- a/lisp/gnus-bbdb.el
+++ b/lisp/gnus-bbdb.el
@@ -1,4 +1,4 @@
-;; gnus-bbdb.el --- Interface to Semi-gnus
+;; gnus-bbdb.el --- Interface to T-gnus
 
 ;; Copyright (c) 1991,1992,1993 Jamie Zawinski <jwz@netscape.com>.
 ;; Copyright (C) 1995,1996,1997 Shuhei KOBAYASHI
@@ -9,7 +9,7 @@
 ;; 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 T-gnus.
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -34,7 +34,8 @@
 (require 'std11)
 (eval-when-compile
   (defvar bbdb-pop-up-elided-display)  ; default unbound.
-  (require 'gnus-win))
+  (require 'gnus-win)
+  (require 'cl))
 
 (defvar gnus-bbdb/decode-field-body-function 'nnheader-decode-field-body
   "*Field body decoder.")
@@ -181,16 +182,32 @@ BBDB-FIELD values is returned.  Otherwise, GROUP is returned."
                                                (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))
-             "\\|")))
+            (with-temp-buffer
+              (let (lal)
+                (while header-values
+                  (setq lal (std11-parse-addresses-string
+                             (pop header-values)))
+                  (while lal
+                    (gnus-bbdb/insert-address-regexp (pop lal)))))
+              (buffer-string))))
        (unless (zerop (length address-regexp))
          (gnus-bbdb/split-mail-1 address-regexp bbdb-field regexp group))))))
 
+(defun gnus-bbdb/insert-address-regexp (address)
+  "Insert string of address part from parsed ADDRESS of RFC 822."
+  (cond ((eq (car address) 'group)
+        (setq address (cdr address))
+        (while address
+          (gnus-bbdb/insert-address-regexp (pop address))))
+       ((eq (car address) 'mailbox)
+        (unless (eq (point) (point-min))
+          (insert "\\|"))
+        (let ((addr (nth 1 address)))
+          (insert (std11-addr-to-string
+                   (if (eq (car addr) 'phrase-route-addr)
+                       (nth 2 addr)
+                     (cdr addr))))))))
+
 (defun gnus-bbdb/split-mail-1 (address-regexp bbdb-field regexp group)
   (let ((records (bbdb-search (bbdb-records) nil nil address-regexp))
        prop rest)