* bbdb-wl.el: merge from main trunk

diff --git a/utils/ChangeLog b/utils/ChangeLog
index 397a19a..47ccf5d 100644 (file)
--- a/utils/ChangeLog
+++ b/utils/ChangeLog
@@ -1,3 +1,43 @@
+2002-06-03  KOBAYASHI Shinji <kobayashi_shinji@nifty.com>
+
+       * bbdb-wl.el (bbdb-wl-canonicalize-spaces-and-dots): Remove
+       the preceding spaces.
+
+2002-05-30  Yuuichi Teranishi  <teranisi@gohome.org>
+
+       * bbdb-wl.el (bbdb-wl-canonicalize-full-name-function): New variable.
+       (bbdb-wl-canonicalize-spaces-and-dots): New function.
+       (bbdb-wl-get-addresses-1): Use bbdb-wl-canonicalize-full-name-function.
+       (bbdb-wl-get-addresses-2): Ditto.
+
+2002-04-28  TAKAHASHI Kaoru  <kaoru@kaisei.org>
+
+       * bbdb-wl.el (bbdb-wl-setup): Add `bbdb-offer-save' to
+       `wl-save-hook'.  Use `bbdb-initialize' instead of require
+       bbdb-autoloads.
+
+2002-01-28  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
+
+       * bbdb-wl.el (bbdb-wl-get-addresses-2): Bind unbound local
+       variable.
+
+2002-01-28  Yuuichi Teranishi  <teranisi@gohome.org>
+
+       * bbdb-wl.el (bbdb-wl-get-addresses-1): New function.
+       (bbdb-wl-get-addresses-2): Ditto.
+       (bbdb-wl-get-addresses): Select bbdb-wl-get-addresses-1 or
+       bbdb-wl-get-addresses-2 according to the bbdb-version.
+       (bbdb-wl-address-headers-spec): New function.
+       (bbdb-wl-show-all-recipients): Use it.
+       (bbdb-wl-show-sender): Ditto.
+       (bbdb-wl-setup): Include defvars for bbdb-get-addresses-headers.
+
+2002-01-07  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
+
+       * bbdb-wl.el (bbdb-wl-ignore-folder-regexp): New variable.
+       (bbdb-wl-get-update-record): Changed to check
+       `bbdb-wl-ignore-folder-regexp'.
+
 2001-12-12  Yuuichi Teranishi  <teranisi@gohome.org>
 
        * bbdb-wl.el (bbdb-wl-setup): Added autoload magic.

diff --git a/utils/bbdb-wl.el b/utils/bbdb-wl.el
index cfabd0c..6896ed6 100644 (file)
--- a/utils/bbdb-wl.el
+++ b/utils/bbdb-wl.el
@@ -31,6 +31,18 @@
 
 (defvar bbdb-wl-get-update-record-hook nil)
 (defvar bbdb-wl-folder-regexp nil)
+(defvar bbdb-wl-ignore-folder-regexp nil)
+
+(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)
 
 ;;;###autoload
 (defun bbdb-wl-setup ()
@@ -38,6 +50,7 @@
   (add-hook 'wl-summary-exit-hook 'bbdb-wl-hide-bbdb-buffer)
   (add-hook 'wl-message-window-deleted-hook 'bbdb-wl-hide-bbdb-buffer)
   (add-hook 'wl-exit-hook 'bbdb-wl-exit)
+  (add-hook 'wl-save-hook 'bbdb-offer-save)
   (add-hook 'wl-summary-toggle-disp-off-hook 'bbdb-wl-hide-bbdb-buffer)
   (add-hook 'wl-summary-toggle-disp-folder-on-hook 'bbdb-wl-hide-bbdb-buffer)
   (add-hook 'wl-summary-toggle-disp-folder-off-hook 'bbdb-wl-hide-bbdb-buffer)
@@ -55,13 +68,21 @@
             (lambda ()
 ;;;           (local-set-key "\M-\t" 'bbdb-complete-name)
               (define-key (current-local-map) "\M-\t" 'bbdb-complete-name))))
-  ;; BBDB 2.00.06 or earlier:
-  ;;  auto-autoloads.el includes (provide 'bbdb-autoloads)
-  ;;  Don't exist bbdb-autoloads.el
-  (when (and (not (featurep 'bbdb-autoloads))
-            (module-installed-p 'bbdb-autoloads))
-    ;; BBDB 2.20: bbdb-autoloads.el NOT includes (provide 'bbdb-autoloads)
-    (load "bbdb-autoloads")))
+  (require 'bbdb)
+  (bbdb-initialize)
+
+  (if (not (boundp 'bbdb-get-addresses-from-headers))
+      (defvar bbdb-get-addresses-from-headers
+       '("From" "Resent-From" "Reply-To")))
+
+  (if (not (boundp 'bbdb-get-addresses-to-headers))
+      (defvar bbdb-get-addresses-to-headers
+       '("Resent-To" "Resent-CC" "To" "CC" "BCC")))
+
+  (if (not (boundp 'bbdb-get-addresses-headers))
+      (defvar bbdb-get-addresses-headers
+       (append bbdb-get-addresses-from-headers
+               bbdb-get-addresses-to-headers))))
 
 (defun bbdb-wl-exit ()
   (let (bbdb-buf)
@@ -70,15 +91,17 @@
   (bbdb-offer-save))
 
 (defun bbdb-wl-get-update-record ()
-  (if (or (null bbdb-wl-folder-regexp)
-         (string-match
-          bbdb-wl-folder-regexp
-          (with-current-buffer
-              wl-message-buffer-cur-summary-buffer
-            (wl-summary-buffer-folder-name))))
-      (with-current-buffer (wl-message-get-original-buffer)
-       (bbdb-wl-update-record)
-       (run-hooks 'bbdb-wl-get-update-record-hook))))
+  (let ((folder-name (with-current-buffer
+                        wl-message-buffer-cur-summary-buffer
+                      (wl-summary-buffer-folder-name))))
+    (if (and (or (null bbdb-wl-folder-regexp)
+                (string-match bbdb-wl-folder-regexp folder-name))
+            (not (and bbdb-wl-ignore-folder-regexp
+                      (string-match bbdb-wl-ignore-folder-regexp
+                                    folder-name))))
+       (with-current-buffer (wl-message-get-original-buffer)
+         (bbdb-wl-update-record)
+         (run-hooks 'bbdb-wl-get-update-record-hook)))))
 
 (defun bbdb-wl-hide-bbdb-buffer ()
   (let (bbdb-buf bbdb-win)
@@ -138,22 +161,11 @@
          from-str)
       string)))
 
-(if (not (boundp 'bbdb-get-addresses-from-headers))
-    (defvar bbdb-get-addresses-from-headers
-      '("From" "Resent-From" "Reply-To")))
-
-(if (not (boundp 'bbdb-get-addresses-to-headers))
-    (defvar bbdb-get-addresses-to-headers
-      '("Resent-To" "Resent-CC" "To" "CC" "BCC")))
-
-(if (not (boundp 'bbdb-get-addresses-headers))
-    (defvar bbdb-get-addresses-headers
-      (append bbdb-get-addresses-from-headers bbdb-get-addresses-to-headers)))
-
-(defun bbdb-wl-get-addresses (&optional only-first-address)
+(defun bbdb-wl-get-addresses-1 (&optional only-first-address)
   "Return real name and email address of sender respectively recipients.
 If an address matches `bbdb-user-mail-names' it will be ignored.
-The headers to search can be configured by `bbdb-get-addresses-headers'."
+The headers to search can be configured by `bbdb-get-addresses-headers'.
+For BBDB 2.33 or earlier."
   (save-excursion
     (save-restriction
       (std11-narrow-to-header)
@@ -167,7 +179,8 @@ The headers to search can be configured by `bbdb-get-addresses-headers'."
                              (std11-unfold-string header)))
            (while (and (setq structure (car structures))
                        (eq (car structure) 'mailbox))
-             (setq fn (std11-full-name-string structure)
+             (setq fn (funcall bbdb-wl-canonicalize-full-name-function
+                               (std11-full-name-string structure))
                    fn (and fn
                            (with-temp-buffer ; to keep raw buffer unibyte.
                              (elmo-set-buffer-multibyte
@@ -176,20 +189,77 @@ The headers to search can be configured by `bbdb-get-addresses-headers'."
                               (decode-mime-charset-string
                                fn wl-mime-charset))))
                    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)))))
+                       (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 headers (cdr headers)))
        (nreverse addrlist)))))
 
+(defun bbdb-wl-get-addresses-2 (&optional only-first-address)
+  "Return real name and email address of sender respectively recipients.
+If an address matches `bbdb-user-mail-names' it will be ignored.
+The headers to search can be configured by `bbdb-get-addresses-headers'.
+For BBDB 2.34 or later."
+  (save-excursion
+    (save-restriction
+      (std11-narrow-to-header)
+      (let ((headers bbdb-get-addresses-headers)
+           (uninteresting-senders bbdb-user-mail-names)
+           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 (funcall bbdb-wl-canonicalize-full-name-function
+                                 (std11-full-name-string structure))
+                     fn (and fn
+                             (with-temp-buffer ; to keep raw buffer unibyte.
+                               (elmo-set-buffer-multibyte
+                                default-enable-multibyte-characters)
+                               (eword-decode-string
+                                (decode-mime-charset-string
+                                 fn wl-mime-charset))))
+                     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 header-type
+                                              (car header-fields)
+                                              (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 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-names' it will be ignored.
+The headers to search can be configured by `bbdb-get-addresses-headers'."
+  (if (string< bbdb-version "2.34")
+      (bbdb-wl-get-addresses-1)
+    (bbdb-wl-get-addresses-2)))
+
 (defun bbdb-wl-update-record (&optional offer-to-create)
   "Returns the record corresponding to the current WL message,
 creating or modifying it as necessary.  A record will be created if
@@ -301,10 +371,23 @@ This buffer will be in `bbdb-mode', with associated keybindings."
         (select-window bbdb-win))
     records))
 
+(defun bbdb-wl-address-headers-spec (address-class)
+  "Return address headers structure for ADDRESS-CLASS."
+  (if (string< bbdb-version "2.34")
+      (cond
+       ((eq address-class 'recipients)
+       bbdb-get-addresses-to-headers)
+       ((eq address-class 'authors)
+       bbdb-get-addresses-from-headers)
+       (t
+       (append bbdb-get-addresses-to-headers
+               bbdb-get-addresses-from-headers)))
+    (list (assoc address-class bbdb-get-addresses-headers))))
+
 (defun bbdb-wl-show-all-recipients ()
   "Show all recipients of this message. Counterpart to `bbdb/vm-show-sender'."
   (interactive)
-  (bbdb-wl-show-records  bbdb-get-addresses-to-headers))
+  (bbdb-wl-show-records (bbdb-wl-address-headers-spec 'recipients)))
 
 (defun bbdb-wl-show-sender (&optional show-recipients)
   "Display the contents of the BBDB for the senders of this message.
@@ -317,7 +400,8 @@ This buffer will be in `bbdb-mode', with associated keybindings."
        ((= 16 show-recipients)
         (bbdb-wl-show-records))
        (t
-        (if (null (bbdb-wl-show-records bbdb-get-addresses-from-headers))
+        (if (null (bbdb-wl-show-records
+                   (bbdb-wl-address-headers-spec 'authors)))
             (bbdb-wl-show-all-recipients)))))
 
 (defun bbdb-wl-pop-up-bbdb-buffer (&optional offer-to-create)