Update to version 2003-01-27.08.

[elisp/wanderlust.git] / wl / wl-address.el

diff --git a/wl/wl-address.el b/wl/wl-address.el
index c9b55bf..d168f52 100644 (file)
--- a/wl/wl-address.el
+++ b/wl/wl-address.el
@@ -1,8 +1,12 @@
-;;; wl-address.el -- Tiny address management for Wanderlust.
+;;; wl-address.el --- Tiny address management for Wanderlust.

 
 

-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Shun-ichi GOTO <gotoh@taiyo.co.jp>
+;; Copyright (C) 1998,1999,2000 Takeshi Chiba <chiba@d3.bs1.fc.nec.co.jp>

 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>

+;;     Shun-ichi GOTO <gotoh@taiyo.co.jp>
+;;     Takeshi Chiba <chiba@d3.bs1.fc.nec.co.jp>

 ;; Keywords: mail, net news
 
 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
 ;; Keywords: mail, net news
 
 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).

@@ -24,21 +28,25 @@
 ;;
 
 ;;; Commentary:
 ;;
 
 ;;; Commentary:

-;; 
+;;

 
 ;;; Code:
 
 ;;; Code:

-;; 
+;;

 
 (require 'wl-util)
 (require 'wl-vars)
 (require 'std11)
 
 
 (require 'wl-util)
 (require 'wl-vars)
 (require 'std11)
 

-(defvar wl-address-complete-header-regexp "^\\(To\\|From\\|Cc\\|Bcc\\|Mail-Followup-To\\|Reply-To\\|Return-Receipt-To\\):")
+(defvar wl-address-complete-header-list 
+  '("To:" "From:" "Cc:" "Bcc:" "Mail-Followup-To:" "Reply-To:"
+    "Return-Receipt-To:"))
+(defvar wl-address-complete-header-regexp nil) ; auto-generated.

 (defvar wl-newsgroups-complete-header-regexp "^\\(Newsgroups\\|Followup-To\\):")
 (defvar wl-newsgroups-complete-header-regexp "^\\(Newsgroups\\|Followup-To\\):")

-(defvar wl-folder-complete-header-regexp "^\\(FCC\\):")
+(defvar wl-folder-complete-header-regexp "^\\(Fcc\\):")

 (defvar wl-address-list nil)
 (defvar wl-address-completion-list nil)
 (defvar wl-address-petname-hash nil)
 (defvar wl-address-list nil)
 (defvar wl-address-completion-list nil)
 (defvar wl-address-petname-hash nil)

+(defvar wl-address-enable-strict-loading t)

 
 (defvar wl-address-ldap-search-hash nil)
 
 
 (defvar wl-address-ldap-search-hash nil)
 

@@ -49,8 +57,8 @@
 Valid value is nit, t, 1 or larget integer.
 
 If this value nil, minimum alias postfix is made depends on uniqness
 Valid value is nit, t, 1 or larget integer.
 
 If this value nil, minimum alias postfix is made depends on uniqness

-with other candidates. In this implementation, it's same to 1.  If t,
-always append all dn data. If number, always append spcified level of
+with other candidates.  In this implementation, it's same to 1.  If t,
+always append all dn data.  If number, always append spcified level of

 data but maybe appended more uniqness.  If invalid value, treat as
 nil.
 
 data but maybe appended more uniqness.  If invalid value, treat as
 nil.
 

@@ -74,13 +82,12 @@ If level 3 is required for uniqness with other candidates,
     2 => Goto/Shun-ichi_GOTO/Mew/Emacs    ... appended more
     3 => Goto/Shun-ichi_GOTO/Mew/Emacs
     4 => Goto/Shun-ichi_GOTO/Mew/Emacs/Lisper
     2 => Goto/Shun-ichi_GOTO/Mew/Emacs    ... appended more
     3 => Goto/Shun-ichi_GOTO/Mew/Emacs
     4 => Goto/Shun-ichi_GOTO/Mew/Emacs/Lisper

-    (so on...)
-")
+    (so on...)")

 
 (defconst wl-ldap-alias-sep "/")
 
 (defconst wl-ldap-search-attribute-type-list
 
 (defconst wl-ldap-alias-sep "/")
 
 (defconst wl-ldap-search-attribute-type-list

-  '("sn" "cn" "mail"))
+  '("sn" "cn" "mail" "email"))

 
 (defun wl-ldap-get-value (type entry)
   ""
 
 (defun wl-ldap-get-value (type entry)
   ""

@@ -93,7 +100,7 @@ If level 3 is required for uniqness with other candidates,
                    values nil)
            (setq values (cdr values)))))
     ret))
                    values nil)
            (setq values (cdr values)))))
     ret))

-         
+

 (defun wl-ldap-get-value-list (type entry)
   ""
   (cdr (assoc type entry)))
 (defun wl-ldap-get-value-list (type entry)
   ""
   (cdr (assoc type entry)))

@@ -101,11 +108,11 @@ If level 3 is required for uniqness with other candidates,
 (defun wl-ldap-make-filter (pat type-list)
   "Make RFC1558 quiery filter for PAT from ATTR-LIST.
 Each are \"OR\" combination, and PAT is beginning-match."
 (defun wl-ldap-make-filter (pat type-list)
   "Make RFC1558 quiery filter for PAT from ATTR-LIST.
 Each are \"OR\" combination, and PAT is beginning-match."

-  (concat "(&(objectclass=person)(|"
+  (concat "(|"

          (mapconcat (lambda (x) (format "(%s=%s*)" x pat)) ; fixed format
                     type-list
                     "")
          (mapconcat (lambda (x) (format "(%s=%s*)" x pat)) ; fixed format
                     type-list
                     "")

-         "))"))
+         ")"))

 
 (defun wl-ldap-make-matched-value-list (regexp type-list entry)
   "Correct matching WORD with value of TYPE-LIST in ENTRY.
 
 (defun wl-ldap-make-matched-value-list (regexp type-list entry)
   "Correct matching WORD with value of TYPE-LIST in ENTRY.

@@ -116,9 +123,8 @@ Returns matched uniq string list."
       (setq type (car (car entry))
            values (mapcar (function wl-ldap-alias-safe-string)
                           (cdr (car entry)))
       (setq type (car (car entry))
            values (mapcar (function wl-ldap-alias-safe-string)
                           (cdr (car entry)))

+           values (elmo-flatten values)

            entry (cdr entry))
            entry (cdr entry))

-      (if (string-match "::?$" type)
-         (setq type (substring type 0 (match-beginning 0))))

       (if (member type type-list)
          (while values
            (setq val (car values)
       (if (member type type-list)
          (while values
            (setq val (car values)

@@ -131,14 +137,13 @@ Returns matched uniq string list."
 (defun wl-ldap-alias-safe-string (str)
   "Modify STR for alias.
 Replace space/tab in STR into '_' char.
 (defun wl-ldap-alias-safe-string (str)
   "Modify STR for alias.
 Replace space/tab in STR into '_' char.

-And remove domain part of mail addr."
-  (while (string-match "[^_a-zA-Z0-9+@%.!\\-/]+" str)
+Replace '@' in STR into list of mailbox and sub-domains."
+  (while (string-match "[ \t]+" str)

     (setq str (concat (substring str 0 (match-beginning 0))
                      "_"
                      (substring str (match-end 0)))))
     (setq str (concat (substring str 0 (match-beginning 0))
                      "_"
                      (substring str (match-end 0)))))

-  (if (string-match "@[^/@]+" str)
-      (setq str (concat (substring str 0 (match-beginning 0))
-                       (substring str (match-end 0)))))
+  (if (string-match "\\(@\\)[^/@]+" str)
+      (setq str (split-string str  "[@\\.]")))

   str)
 
 (defun wl-ldap-register-dn-string (hash dn &optional str dn-list)
   str)
 
 (defun wl-ldap-register-dn-string (hash dn &optional str dn-list)

@@ -154,7 +159,8 @@ And remove domain part of mail addr."
                                    (if (string-match "[a-z]+=\\(.*\\)" str)
                                        (wl-ldap-alias-safe-string
                                         (wl-match-string 1 str))))
                                    (if (string-match "[a-z]+=\\(.*\\)" str)
                                        (wl-ldap-alias-safe-string
                                         (wl-match-string 1 str))))

-                                 (split-string dn ",")))))
+                                 (split-string dn "[ \t]*,[ \t]*")))))
+      (setq dn-list (elmo-flatten dn-list))

       ;; prepare candidate for uniq str
       (if str
          (setq str (concat str wl-ldap-alias-sep (car dn-list))
       ;; prepare candidate for uniq str
       (if str
          (setq str (concat str wl-ldap-alias-sep (car dn-list))

@@ -196,9 +202,9 @@ Matched address lists are append to CL."
   (let ((pat (if (string-match wl-ldap-alias-sep pattern)
                 (substring pattern 0 (match-beginning 0))
               pattern))
   (let ((pat (if (string-match wl-ldap-alias-sep pattern)
                 (substring pattern 0 (match-beginning 0))
               pattern))

-       (ldap-default-host wl-ldap-server)
-       (ldap-default-port (or wl-ldap-port 389))
-       (ldap-default-base wl-ldap-base)
+       (ldap-default-host (or wl-ldap-server ldap-default-host "localhost"))
+       (ldap-default-port (or wl-ldap-port ldap-default-port 389))
+       (ldap-default-base (or wl-ldap-base ldap-default-base))

        (dnhash (elmo-make-hash))
        cache len sym tmpl regexp entries ent values dn dnstr alias
        result cn mails)
        (dnhash (elmo-make-hash))
        cache len sym tmpl regexp entries ent values dn dnstr alias
        result cn mails)

@@ -216,17 +222,14 @@ Matched address lists are append to CL."
     ;; get matched entries
     (if cache
        (setq entries (cdr cache))
     ;; get matched entries
     (if cache
        (setq entries (cdr cache))

-      (condition-case nil
-         (progn
-           (message "Searching in LDAP...")
-           (setq entries (ldap-search-entries
-                          (wl-ldap-make-filter
-                           (concat pat "*")
-                           wl-ldap-search-attribute-type-list)
-                          nil wl-ldap-search-attribute-type-list nil t))
-           (message "Searching in LDAP...done")
-           (elmo-set-hash-val pattern entries wl-address-ldap-search-hash))
-       (error (message ""))))                  ; ignore error: No such object
+      (ignore-errors
+       (message "Searching in LDAP...")
+       (setq entries (ldap-search-entries
+                      (wl-ldap-make-filter
+                       pat wl-ldap-search-attribute-type-list)
+                      nil wl-ldap-search-attribute-type-list nil t))
+       (message "Searching in LDAP...done")
+       (elmo-set-hash-val pattern entries wl-address-ldap-search-hash)))

     ;;
     (setq tmpl entries)
     (while tmpl
     ;;
     (setq tmpl entries)
     (while tmpl

@@ -237,8 +240,10 @@ Matched address lists are append to CL."
     (while entries
       (setq ent (cdar entries)
            values (wl-ldap-make-matched-value-list
     (while entries
       (setq ent (cdar entries)
            values (wl-ldap-make-matched-value-list

-                   regexp '("mail" "sn" "cn") ent)
-           mails (wl-ldap-get-value-list "mail" ent)
+                   regexp wl-ldap-search-attribute-type-list
+                   ent)
+           mails (or (wl-ldap-get-value-list "mail" ent)
+                     (wl-ldap-get-value-list "email" ent))

            cn (wl-ldap-get-value "cn" ent)
            dn (car (car entries))
            dnstr (elmo-get-hash-val (upcase dn) dnhash))
            cn (wl-ldap-get-value "cn" ent)
            dn (car (car entries))
            dnstr (elmo-get-hash-val (upcase dn) dnhash))

@@ -276,37 +281,41 @@ Matched address lists are append to CL."
        (completing-read "To: " cl)
       (read-string "To: "))))
 
        (completing-read "To: " cl)
       (read-string "To: "))))
 

-(defun wl-address-quote-specials (word)
-  "Make quoted string of WORD if needed."
-  (if (assq 'specials (std11-lexical-analyze word))
-      (prin1-to-string word)
-    word))
+(defalias 'wl-address-quote-specials 'elmo-address-quote-specials)

 
 (defun wl-address-make-completion-list (address-list)
   (let (addr-tuple cl)
     (while address-list
       (setq addr-tuple (car address-list))
       (setq cl
 
 (defun wl-address-make-completion-list (address-list)
   (let (addr-tuple cl)
     (while address-list
       (setq addr-tuple (car address-list))
       (setq cl

-            (cons
-             (cons (nth 0 addr-tuple)
-                   (concat
-                    (wl-address-quote-specials
-                     (nth 2 addr-tuple)) " <"(nth 0 addr-tuple)">"))
-             cl))
+           (cons
+            (wl-address-make-completion-entry 0 addr-tuple)
+            cl))

       ;; nickname completion.
       ;; nickname completion.

-      (unless (or (equal (nth 1 addr-tuple) (nth 0 addr-tuple))
-                 ;; already exists
-                 (assoc (nth 1 addr-tuple) cl))
+      (if wl-address-enable-strict-loading
+         (unless (or (equal (nth 1 addr-tuple) (nth 0 addr-tuple))
+                     ;; already exists
+                     (assoc (nth 1 addr-tuple) cl))
+           (setq cl
+                 (cons
+                  (wl-address-make-completion-entry 1 addr-tuple)
+                  cl)))

        (setq cl
              (cons
        (setq cl
              (cons

-              (cons (nth 1 addr-tuple)
-                    (concat
-                     (wl-address-quote-specials
-                      (nth 2 addr-tuple)) " <"(nth 0 addr-tuple)">"))
+              (wl-address-make-completion-entry 1 addr-tuple)

               cl)))
       (setq address-list (cdr address-list)))
     cl))
 
               cl)))
       (setq address-list (cdr address-list)))
     cl))
 

+(defun wl-address-make-completion-entry (index addr-tuple)
+  (cons (nth index addr-tuple)
+       (if (or (string= (nth 2 addr-tuple) "")
+               (string-match ".*:.*;$" (nth 0 addr-tuple)))
+           (nth 0 addr-tuple)
+         (concat
+          (wl-address-quote-specials
+           (nth 2 addr-tuple)) " <"(nth 0 addr-tuple)">"))))
+

 (defun wl-complete-field-body-or-tab ()
   (interactive)
   (let ((case-fold-search t)
 (defun wl-complete-field-body-or-tab ()
   (interactive)
   (let ((case-fold-search t)

@@ -359,7 +368,7 @@ Matched address lists are append to CL."
     (with-output-to-temp-buffer
        wl-completion-buf-name
       (display-completion-list all))
     (with-output-to-temp-buffer
        wl-completion-buf-name
       (display-completion-list all))

-    (message "Making completion list... done")))
+    (message "Making completion list...done")))

 
 (defun wl-complete-window-delete ()
   (let (comp-buf comp-win)
 
 (defun wl-complete-window-delete ()
   (let (comp-buf comp-win)

@@ -379,15 +388,15 @@ Matched address lists are append to CL."
     (if (null cl)
        nil
       (setq completion
     (if (null cl)
        nil
       (setq completion

-            (let ((completion-ignore-case t))
-              (try-completion pattern cl)))
+           (let ((completion-ignore-case t))
+             (try-completion pattern cl)))

       (cond ((eq completion t)
             (let ((alias (assoc pattern cl)))
               (if alias
                   (progn
                     (delete-region start end)
                     (insert (cdr alias))
       (cond ((eq completion t)
             (let ((alias (assoc pattern cl)))
               (if alias
                   (progn
                     (delete-region start end)
                     (insert (cdr alias))

-               ;     (wl-highlight-message (point-min)(point-max) t)
+;;;                 (wl-highlight-message (point-min)(point-max) t)

                     )))
             (wl-complete-window-delete))
            ((null completion)
                     )))
             (wl-complete-window-delete))
            ((null completion)

@@ -425,6 +434,7 @@ Matched address lists are append to CL."
         (completion)
         (pattern (buffer-substring start end))
         (len (length pattern))
         (completion)
         (pattern (buffer-substring start end))
         (len (length pattern))

+        (completion-ignore-case t)

         (cl completion-list))
     (when use-ldap
       (setq cl (wl-address-ldap-search pattern cl)))
         (cl completion-list))
     (when use-ldap
       (setq cl (wl-address-ldap-search pattern cl)))

@@ -454,12 +464,16 @@ Matched address lists are append to CL."
             (let ((list (sort (all-completions pattern cl) 'string<)))
               (wl-complete-window-show list)))))))
 
             (let ((list (sort (all-completions pattern cl) 'string<)))
               (wl-complete-window-show list)))))))
 

-(defvar wl-address-init-func 'wl-local-address-init)
+(defvar wl-address-init-function 'wl-local-address-init)

 
 (defun wl-address-init ()
 
 (defun wl-address-init ()

-  (funcall wl-address-init-func))
+  "Call `wl-address-init-function'."
+  (funcall wl-address-init-function))

 
 (defun wl-local-address-init ()
 
 (defun wl-local-address-init ()

+  "Reload `wl-address-file'.
+Refresh `wl-address-list', `wl-address-completion-list', and
+`wl-address-petname-hash'."

   (message "Updating addresses...")
   (setq wl-address-list
        (wl-address-make-address-list wl-address-file))
   (message "Updating addresses...")
   (setq wl-address-list
        (wl-address-make-address-list wl-address-file))

@@ -483,24 +497,24 @@ Matched address lists are append to CL."
   (when (< nest-count 5)
     (let (expn-str new-expn-str expn new-expn(n 0) (expanded nil))
       (while (setq expn-str (cdr (nth n alist)))
   (when (< nest-count 5)
     (let (expn-str new-expn-str expn new-expn(n 0) (expanded nil))
       (while (setq expn-str (cdr (nth n alist)))

-        (setq new-expn-str nil)
-        (while (string-match "^[ \t]*\\([^,]+\\)" expn-str)
-          (setq expn (elmo-match-string 1 expn-str))
+       (setq new-expn-str nil)
+       (while (string-match "^[ \t]*\\([^,]+\\)" expn-str)
+         (setq expn (elmo-match-string 1 expn-str))

          (setq expn-str (wl-string-delete-match expn-str 0))
          (setq expn-str (wl-string-delete-match expn-str 0))

-          (if (string-match "^[ \t,]+" expn-str)
+         (if (string-match "^[ \t,]+" expn-str)

              (setq expn-str (wl-string-delete-match expn-str 0)))
              (setq expn-str (wl-string-delete-match expn-str 0)))

-          (if (string-match "[ \t,]+$" expn)
+         (if (string-match "[ \t,]+$" expn)

              (setq expn (wl-string-delete-match expn 0)))
              (setq expn (wl-string-delete-match expn 0)))

-          (setq new-expn (cdr (assoc expn alist)))
-          (if new-expn
-              (setq expanded t))
-          (setq new-expn-str (concat new-expn-str (and new-expn-str ", ")
-                                     (or new-expn expn))))
-        (when new-expn-str
-          (setcdr (nth n alist) new-expn-str))
-        (setq n (1+ n)))
+         (setq new-expn (cdr (assoc expn alist)))
+         (if new-expn
+             (setq expanded t))
+         (setq new-expn-str (concat new-expn-str (and new-expn-str ", ")
+                                    (or new-expn expn))))
+       (when new-expn-str
+         (setcdr (nth n alist) new-expn-str))
+       (setq n (1+ n)))

       (and expanded
       (and expanded

-           (wl-address-expand-aliases alist (1+ nest-count))))))
+          (wl-address-expand-aliases alist (1+ nest-count))))))

 
 (defun wl-address-make-alist-from-alias-file (file)
   (elmo-set-work-buf
 
 (defun wl-address-make-alist-from-alias-file (file)
   (elmo-set-work-buf

@@ -510,7 +524,7 @@ Matched address lists are append to CL."
       (while (re-search-forward ",$" nil t)
        (end-of-line)
        (forward-char 1)
       (while (re-search-forward ",$" nil t)
        (end-of-line)
        (forward-char 1)

-       (delete-backward-char 1))
+       (delete-backward-char 1))

       (goto-char (point-min))
       (while (re-search-forward "^\\([^#;\n][^:]+\\):[ \t]*\\(.*\\)$" nil t)
        (setq alias (wl-match-buffer 1)
       (goto-char (point-min))
       (while (re-search-forward "^\\([^#;\n][^:]+\\):[ \t]*\\(.*\\)$" nil t)
        (setq alias (wl-match-buffer 1)

@@ -519,27 +533,27 @@ Matched address lists are append to CL."
       (wl-address-expand-aliases alist 0)
       (nreverse alist) ; return value
       )))
       (wl-address-expand-aliases alist 0)
       (nreverse alist) ; return value
       )))

-       
+

 (defun wl-address-make-address-list (path)
   (if (and path (file-readable-p path))
       (elmo-set-work-buf
 (defun wl-address-make-address-list (path)
   (if (and path (file-readable-p path))
       (elmo-set-work-buf

-       (let (ret
-             (coding-system-for-read wl-cs-autoconv))
-         (insert-file-contents path)
-         (goto-char (point-min))
-         (while (not (eobp))
-           (if (looking-at
- "^\\([^#\n][^ \t\n]+\\)[ \t]+\"\\(.*\\)\"[ \t]+\"\\(.*\\)\"[ \t]*.*$")
-               (setq ret
-                     (wl-append-element
-                      ret
-                      (list (wl-match-buffer 1)
-                            (wl-match-buffer 2)
-                            (wl-match-buffer 3)))))
-           (forward-line))
-         ret))))
-
-(defsubst wl-address-get-petname-1 (string)
+       (let (ret
+            (coding-system-for-read wl-cs-autoconv))
+        (insert-file-contents path)
+        (goto-char (point-min))
+        (while (not (eobp))
+          (if (looking-at
+               "^\\([^#\n][^ \t\n]+\\)[ \t]+\\(\".*\"\\)[ \t]+\\(\".*\"\\)[ \t]*.*$")
+              (setq ret
+                    (cons
+                     (list (wl-match-buffer 1)
+                           (read (wl-match-buffer 2))
+                           (read (wl-match-buffer 3)))
+                     ret)))
+          (forward-line))
+        (nreverse ret)))))
+
+(defun wl-address-get-petname-1 (string)

   (let ((address (downcase (wl-address-header-extract-address string))))
     (elmo-get-hash-val address wl-address-petname-hash)))
 
   (let ((address (downcase (wl-address-header-extract-address string))))
     (elmo-get-hash-val address wl-address-petname-hash)))
 

@@ -556,24 +570,24 @@ Matched address lists are append to CL."
                      wl-from))))))
 
 (defsubst wl-address-header-extract-address (str)
                      wl-from))))))
 
 (defsubst wl-address-header-extract-address (str)

-  "Extracts a real e-mail address from STR and returns it.
+  "Extracts a real e-mail address from STR and return it.

 e.g. \"Mine Sakurai <m-sakura@ccs.mt.nec.co.jp>\"
   ->  \"m-sakura@ccs.mt.nec.co.jp\".
 e.g. \"m-sakura@ccs.mt.nec.co.jp (Mine Sakurai)\"
   ->  \"m-sakura@ccs.mt.nec.co.jp\"."
   (cond ((string-match ".*<\\([^>]*\\)>" str) ; .* to extract last <>
 e.g. \"Mine Sakurai <m-sakura@ccs.mt.nec.co.jp>\"
   ->  \"m-sakura@ccs.mt.nec.co.jp\".
 e.g. \"m-sakura@ccs.mt.nec.co.jp (Mine Sakurai)\"
   ->  \"m-sakura@ccs.mt.nec.co.jp\"."
   (cond ((string-match ".*<\\([^>]*\\)>" str) ; .* to extract last <>

-         (wl-match-string 1 str))
-        ((string-match "\\([^ \t\n]*@[^ \t\n]*\\)" str)

         (wl-match-string 1 str))
         (wl-match-string 1 str))

-        (t str)))
+       ((string-match "\\([^ \t\n]*@[^ \t\n]*\\)" str)
+        (wl-match-string 1 str))
+       (t str)))

 
 (defsubst wl-address-header-extract-realname (str)
 
 (defsubst wl-address-header-extract-realname (str)

-  "Extracts a real name from STR and returns it.
+  "Extracts a real name from STR and return it.

 e.g. \"Mr. bar <hoge@foo.com>\"
   ->  \"Mr. bar\"."
   (cond ((string-match "\\(.*[^ \t]\\)[ \t]*<[^>]*>" str)
 e.g. \"Mr. bar <hoge@foo.com>\"
   ->  \"Mr. bar\"."
   (cond ((string-match "\\(.*[^ \t]\\)[ \t]*<[^>]*>" str)

-         (wl-match-string 1 str))
-        (t "")))
+        (wl-match-string 1 str))
+       (t "")))

 
 (defmacro wl-address-concat-token (string token)
   (` (cond
 
 (defmacro wl-address-concat-token (string token)
   (` (cond

@@ -620,70 +634,67 @@ Group list contents is not included."
       (setq sequence (cdr sequence)))))
   address-string))
 
       (setq sequence (cdr sequence)))))
   address-string))
 

-(defun wl-address-petname-delete (the-email)
-  "Delete petname in wl-address-file."
-  (let* ( (tmp-buf (get-buffer-create " *wl-petname-tmp*"))
-         (output-coding-system
-          (mime-charset-to-coding-system wl-mime-charset)))
-    (set-buffer tmp-buf)
-    (message "Deleting Petname...")
-    (erase-buffer)
-    (insert-file-contents wl-address-file)
-    (delete-matching-lines (concat "^[ \t]*" the-email))
-    (write-region (point-min) (point-max)
-                 wl-address-file nil 'no-msg)
-    (message "Deleting Petname...done")
-    (kill-buffer tmp-buf)))
-
-
-(defun wl-address-petname-add-or-change (the-email
-                                        default-petname
-                                        default-realname
-                                        &optional change-petname)
-  "Add petname to wl-address-file, if not registerd.
+(defun wl-address-delete (the-email)
+  "Delete address entry in the `wl-address-file'."
+  (let ((output-coding-system
+        (mime-charset-to-coding-system wl-mime-charset)))
+    (with-temp-buffer
+      (message "Deleting Address...")
+      (insert-file-contents wl-address-file)
+      (delete-matching-lines (concat "^[ \t]*" the-email))
+      (write-region (point-min) (point-max)
+                   wl-address-file nil 'no-msg)
+      ;; Delete entries.
+      (dolist (entry (elmo-string-assoc-all the-email wl-address-list))
+       (setq wl-address-list (delete entry wl-address-list)))
+      (elmo-set-hash-val the-email nil wl-address-petname-hash)
+      (message "Deleting Address...done"))))
+
+(defun wl-address-add-or-change (address
+                                &optional default-realname
+                                change-address)
+  "Add address entry to `wl-address-file', if not registerd.

 If already registerd, change it."
 If already registerd, change it."

-  (let (the-realname the-petname)
-
-    ;; setup output "petname"
-    ;; if null petname'd, let default-petname be the petname.
-    (setq the-petname
-         (read-from-minibuffer (format "Petname: ") default-petname))
-    (if (string= the-petname "")
-       (setq the-petname (or default-petname the-email)))
-
-    ;; setup output "realname"
+  (let ((entry (assoc address wl-address-list))
+       the-realname the-petname new-addr addr-changed)

     (setq the-realname
     (setq the-realname

-       (read-from-minibuffer (format "Real Name: ") default-realname))
-;;     (if (string= the-realname "")
-;;         (setq the-realname default-petname))
-
+         (read-from-minibuffer "Real Name: " (or default-realname
+                                                 (nth 2 entry))))
+    (setq the-petname (read-from-minibuffer "Petname: "
+                                           (or (nth 1 entry)
+                                               the-realname)))
+    (when change-address
+      (setq new-addr (read-from-minibuffer "E-Mail: " address))
+      (if (and (not (string= address new-addr))
+              (assoc new-addr wl-address-list))
+         (error "'%s' already exists" new-addr)))

     ;; writing to ~/.address
     ;; writing to ~/.address

-    (let ( (tmp-buf (get-buffer-create " *wl-petname-tmp*"))
-          (output-coding-system (mime-charset-to-coding-system wl-mime-charset)))
-      (set-buffer tmp-buf)
-      (message "Adding Petname...")
-      (erase-buffer)
-      (if (file-exists-p wl-address-file)
-         (insert-file-contents wl-address-file))
-      (if (not change-petname)
-         ;; if only add
-         (progn
-           (goto-char (point-max))
-           (if (and (> (buffer-size) 0)
-                    (not (eq (char-after (1- (point-max))) ?\n)))
-               (insert "\n")))
-       ;; if change
-       (if (re-search-forward (concat "^[ \t]*" the-email) nil t)
+    (let ((output-coding-system
+          (mime-charset-to-coding-system wl-mime-charset)))
+      (with-temp-buffer
+       (if (file-exists-p wl-address-file)
+           (insert-file-contents wl-address-file))
+       (if (null entry)
+           ;; add
+           (progn
+             (goto-char (point-max))
+             (if (and (> (buffer-size) 0)
+                      (not (eq (char-after (1- (point-max))) ?\n)))
+                 (insert "\n")))
+         ;; override
+         (while (re-search-forward (concat "^[ \t]*" address) nil t)

            (delete-region (save-excursion (beginning-of-line)
                                           (point))
                           (save-excursion (end-of-line)
                                           (+ 1 (point))))))
            (delete-region (save-excursion (beginning-of-line)
                                           (point))
                           (save-excursion (end-of-line)
                                           (+ 1 (point))))))

-      (insert (format "%s\t\"%s\"\t\"%s\"\n"
-                     the-email the-petname the-realname))
-      (write-region (point-min) (point-max)
-                   wl-address-file nil 'no-msg)
-      (message "Adding Petname...done")
-      (kill-buffer tmp-buf))))
+       (insert (format "%s\t%s\t%s\n"
+                       (or new-addr address)
+                       (prin1-to-string the-petname)
+                       (prin1-to-string the-realname)))
+       (write-region (point-min) (point-max)
+                     wl-address-file nil 'no-msg)
+       (wl-address-init)
+       (list (or new-addr address) the-petname the-realname)))))

 
 (require 'product)
 (product-provide (provide 'wl-address) (require 'wl-version))
 
 (require 'product)
 (product-provide (provide 'wl-address) (require 'wl-version))