From: murata <murata>
Date: Sat, 22 Sep 2001 04:03:15 +0000 (+0000)
Subject: Add wl-addrbook.el and wl-complete.el to utils.
X-Git-Tag: wl-2_7_5~53
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8b5f252276cfcb769e3ba669677630f3f4072f0c;p=elisp%2Fwanderlust.git

Add wl-addrbook.el and wl-complete.el to utils.
---

diff --git a/WL-ELS b/WL-ELS
index 69f6c8e..785548d 100644
--- a/WL-ELS
+++ b/WL-ELS
@@ -59,7 +59,7 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Utils
-(defvar UTILS-MODULES '(rfc2368 wl-mailto))
+(defvar UTILS-MODULES '(rfc2368 wl-mailto wl-addrbook wl-complete))
 
 ;; OpenSSL/SSLeay package is also needed.
 (if (module-installed-p 'base64)
diff --git a/doc/wl-ja.texi b/doc/wl-ja.texi
index df3c4f5..51d5085 100644
--- a/doc/wl-ja.texi
+++ b/doc/wl-ja.texi
@@ -5919,6 +5919,7 @@ LDAP $B$rMxMQ$9$k>l9g$O!"(B@code{wl-ldap-server}$B!"(B@code{wl-ldap-port},
 * X-Face::                      x-face,bitmap-mule
 * dired-dd::                    dired-dd.el
 * MHC::                         MHC
+* Addrbook::                    Addrbook
 @end menu
 
 
@@ -6109,7 +6110,7 @@ Emacs $B$GJT=8Cf$NAp9F%P%C%U%!$X(B dired $B$+$i%I%i%C%0(B&$B%I%m%C%W$9$k$@$
 @end group
 @end lisp
 
-@node MHC,  , dired-dd, Living with other packages
+@node MHC, Addrbook, dired-dd, Living with other packages
 @subsection mhc.el
 @pindex MHC
 
@@ -6138,6 +6139,24 @@ mhc-current $B$N>l9g!'(B
 @end group
 @end lisp
 
+@node Addrbook,  , MHC, Living with other packages
+@subsection wl-addrbook.el
+@pindex Addrbook
+
+Addrbook of Mew
+(@uref{http://www.mew.org/})
+
+Mew $B$N(B Addrbook $B$r(B Wanderlust $B$G;HMQ$G$-$k$h$&$K$9$k$K$O!"(B
+@file{util/wl-addrbook.el} $B$H(B @file{util/wl-complete.el} $B$r(B 
+@code{load-path} $B$K$*$$$F!"0J2<$N$h$&$K@_Dj$7$^$9!#(B
+
+@lisp
+@group
+(require 'wl-addrbook)
+(wl-addrbook-setup)
+@end group
+@end lisp
+
 @node Highlights, Biff, Living with other packages, Customization
 @section $B%O%$%i%$%H$N@_Dj(B
 
diff --git a/doc/wl.texi b/doc/wl.texi
index 1c69a02..9bc2fb4 100644
--- a/doc/wl.texi
+++ b/doc/wl.texi
@@ -6007,6 +6007,7 @@ Examples with other packages.
 * X-Face::                      x-face,bitmap-mule
 * dired-dd::                    dired-dd.el
 * MHC::                         MHC
+* Addrbook::                    Addrbook
 @end menu
 
 
@@ -6196,7 +6197,7 @@ specific, but general-purpose for SEMI).
 @end group
 @end lisp
 
-@node MHC,  , dired-dd, Living with other packages
+@node MHC, Addrbook, dired-dd, Living with other packages
 @subsection mhc.el
 @pindex MHC
 
@@ -6225,6 +6226,23 @@ For mhc-current:
 @end group
 @end lisp
 
+@node Addrbook,  , MHC, Living with other packages
+@subsection wl-addrbook.el
+@pindex Addrbook
+
+Addrbook of Mew
+(@uref{http://www.mew.org/})
+
+Place @file{util/wl-addrbook.el} and @file{util/wl-complete.el} on the
+@code{load-path} and do the following settings.
+
+@lisp
+@group
+(require 'wl-addrbook)
+(wl-addrbook-setup)
+@end group
+@end lisp
+
 @node Highlights, Biff, Living with other packages, Customization
 @section Highlights
 
diff --git a/utils/wl-addrbook.el b/utils/wl-addrbook.el
new file mode 100644
index 0000000..a650467
--- /dev/null
+++ b/utils/wl-addrbook.el
@@ -0,0 +1,621 @@
+;; wl-addrbook.el --- Aliases and personal information
+
+;; Author:  Masahiro MURATA <muse@ba2.so-net.ne.jp>
+;;	Kazu Yamamoto <Kazu@Mew.org>
+;; Keywords: mail, net news
+
+;;; Commentary:
+
+;;  Insert the following lines in your ~/.wl
+;;
+;; (require 'wl-addrbook)
+;; (wl-addrbook-setup)
+
+;; Original code: Kazu Yamamoto <Kazu@Mew.org>
+;;	mew-addrbook.el (Mew developing team)
+
+;;; Code:
+
+(require 'wl-util)
+
+(defvar wl-addrbook-file "~/.im/Addrbook"
+  "*Addrbook file for completion")
+(defvar wl-addrbook-expand-max-depth 5
+  "*A value to limit alias(addrbook) expansion loop.")
+(defvar wl-addrbook-comment-regexp "^;.*$\\|#.*$"
+  "*Regular expression for \".im/Addrbook\".")
+(defvar wl-addrbook-override-by-newone t
+  "If non-nil, the 'user' entry in 'wl-alias-auto-alist'
+is override by a new entry of (user different-address). 
+This means that addresses in To: and Cc: in Draft mode are
+always learned with an exception 'user' is defined in Addrbook.
+If nil,  the old 'user' entry remains.")
+
+;;(defvar wl-anonymous-recipients ":;")
+
+(defvar wl-addrbook-hashtb nil)
+
+(defvar wl-addrbook-strip-domainpart t
+  "*If *non-nil*, a shortname is created by stripping its domain part.")
+
+(defvar wl-addrbook-alist nil
+  "(key addr) or (key (addr1, addr2) nickname name)")
+(defvar wl-alias-auto-alist nil
+  "(key addr)")
+(defvar wl-alias-auto-file-name "auto-alias")
+
+(defvar wl-summary-use-addrbook-from-func t)
+
+;;; utils
+
+(defun wl-uniq-alist (alst)
+  "Distractively uniqfy elements of ALST."
+  (let ((tmp alst))
+    (while tmp (setq tmp (setcdr tmp (wl-delete-alist2 (car (car tmp)) (cdr tmp))))))
+  alst)
+
+(defun wl-delete-alist2 (key alist)
+  "Destructively delete elements whose first member is equal to key"
+  (if (null key)
+      alist
+    (let (ret)
+      (while (equal (car (nth 0 alist)) key)
+	(setq alist (cdr alist)))
+      (setq ret alist)
+      (while alist
+	(if (equal (car (nth 1 alist)) key)
+	    (setcdr alist (cdr (cdr alist)))
+	  (setq alist (cdr alist))))
+      ret)))
+
+(defun wl-get-next (LIST MEM)
+  (let (frst next crnt)
+    (setq frst (car LIST))
+    (setq LIST (cdr LIST))
+    (setq next (car LIST))
+    (if (equal frst MEM)
+	(if next next frst)
+    (catch 'loop
+      (while LIST
+	(setq crnt next)
+	(setq LIST (cdr LIST))
+	(setq next (car LIST))
+	(if (equal crnt MEM)
+	    (throw 'loop (if next next frst))))))))
+
+(defun wl-address-extract-user (addr)
+  "Extracts username from ADDR"
+  (if (string-match "@.*:" addr) ;; xxx what's this?
+      (setq addr (substring addr (match-end 0) nil))
+    (setq addr (elmo-replace-in-string addr " " "_"))
+    (setq addr (substring addr 0 (string-match "%" addr)))
+    (setq addr (substring addr 0 (string-match "@" addr)))
+    ;; just for refile:  "To: recipients:;" -> recipients
+    ;;(setq addr (substring addr 0 (string-match wl-anonymous-recipients addr)))
+    ;; removing Notes domain
+    (setq addr (substring addr 0 (string-match "/" addr)))))
+
+(defun wl-address-parse-address-list (addrs)
+  (mapcar 'wl-address-header-extract-address (wl-parse-addresses addrs)))
+
+;; hash table for wl-addrbook-alist
+(defmacro wl-addrbook-hashtb ()
+  (` (or wl-addrbook-hashtb
+	 (setq wl-addrbook-hashtb (elmo-make-hash 1021)))))
+
+(defsubst wl-addrbook-get-record-by-addr (addr &optional alist)
+  (elmo-get-hash-val (downcase addr) (wl-addrbook-hashtb)))
+
+(defsubst wl-addrbook-get-record-by-alias (alias &optional alist)
+  (elmo-get-hash-val (format "#%s" (downcase alias)) (wl-addrbook-hashtb)))
+
+(defun wl-addrbook-make-hashtb ()
+  (let ((ht (wl-addrbook-hashtb))
+	(alist wl-addrbook-alist)
+	list addrs addr)
+    (while alist
+      (setq list (car alist)
+	    alist (cdr alist))
+      ;; key is alias
+      (if (car list)
+	  (elmo-set-hash-val (format "#%s" (downcase (car list))) list ht))
+      (when (listp (setq addrs (nth 1 list)))
+	(while addrs
+	  (setq addr (car addrs)
+		addrs (cdr addrs))
+	  ;; key is address
+	  (elmo-set-hash-val (downcase addr) list ht))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Address book
+;;;
+
+(defun wl-addrbook-setup ()
+  (require 'wl-complete)
+  ;; replace wl-address-init function.
+  (setq wl-address-init-function 'wl-addrbook-init)
+  ;;
+  (when wl-summary-use-addrbook-from-func
+    (setq wl-summary-from-function 'wl-summary-addrbook-from))
+  (define-key wl-summary-mode-map "\C-c\C-a" 'wl-summary-addrbook-add)
+  (define-key wl-draft-mode-map "\C-i"     'wl-draft-addrbook-header-comp-or-tab)
+  (define-key wl-draft-mode-map "\e\t"     'wl-draft-addrbook-expand)
+  (define-key wl-draft-mode-map "\C-c\t"   'wl-draft-circular-comp)
+  (add-hook 'mail-send-hook 'wl-draft-learn-alias))
+
+(defun wl-addrbook-init ()
+  (message "Updating addrbook...")
+  (or wl-alias-auto-alist
+      (if wl-alias-auto-file-name
+	  (setq wl-alias-auto-alist
+		(elmo-object-load (expand-file-name
+				   wl-alias-auto-file-name
+				   elmo-msgdb-dir)))))
+  (setq wl-addrbook-alist (wl-addrbook-make-alist))
+  ;; wl-alias-auto-alist is used independently so must use copy-alist
+  (if wl-addrbook-alist
+      (nconc wl-addrbook-alist (copy-alist wl-alias-auto-alist))
+    (setq wl-addrbook-alist (copy-alist wl-alias-auto-alist)))
+;;   (if wl-addrbook-alist
+;;       (nconc wl-addrbook-alist (wl-petname-make-alist))
+;;     (setq wl-addrbook-version (wl-petname-make-alist)))
+  (setq wl-addrbook-alist (wl-uniq-alist wl-addrbook-alist))
+  (wl-addrbook-make-hashtb)
+  (add-hook 'kill-emacs-hook (function wl-addrbook-clean-up))
+  (add-hook 'wl-exit-hook (function wl-addrbook-clean-up))
+  (message "Updating addrbook...done."))
+
+(defun wl-addrbook-clean-up ()
+  (remove-hook 'kill-emacs-hook (function wl-addrbook-clean-up))
+  (remove-hook 'wl-exit-hook (function wl-addrbook-clean-up))
+  (when wl-alias-auto-file-name
+    (elmo-object-save (expand-file-name
+		       wl-alias-auto-file-name
+		       elmo-msgdb-dir)
+		      wl-alias-auto-alist)
+    (setq wl-alias-auto-alist nil)
+    (setq wl-addrbook-hashtb nil)))
+
+;;
+
+(defmacro wl-alias-get (key)
+  (` (wl-addrbook-alias-get (, key) wl-addrbook-alist)))
+
+(defmacro wl-alias-next (key)
+  (` (wl-addrbook-alias-next (, key) wl-addrbook-alist)))
+
+(defalias 'wl-addrbook-alias-hit 'wl-addrbook-get-record-by-alias)
+
+(defun wl-addrbook-alias-get (key alist)
+  (let ((addrs (wl-addrbook-alias-get1 key alist 0)))
+    (cond
+     ((stringp addrs) addrs)
+     ((listp addrs)
+      (mapconcat (lambda (x) x) (nreverse addrs) ", "))
+     (t key))))
+
+(defun wl-addrbook-alias-get1 (key alist n)
+  "Expand KEY to addresses according ALIST.
+If addresses is a list, that follows one-of convention and
+return the first member of the list.
+If addresses is a string, expands it recursively."
+  (let* ((crnt (nth 1 (wl-addrbook-alias-hit key alist)))
+	 (keys (and (stringp crnt)
+		    (elmo-parse crnt "\\([^, \t]+\\)")))
+	 ret tmp)
+    (cond
+     ((> n wl-addrbook-expand-max-depth) key)
+     ((null crnt) key)
+     ((listp crnt) (car crnt))
+     (t
+      (while keys
+	(setq tmp (wl-addrbook-alias-get1 (car keys) alist (1+ n)))
+	(if (listp tmp)
+	    (setq ret (nconc tmp ret))
+	  (setq ret (cons tmp ret)))
+	(setq keys (cdr keys)))
+      ret))))
+
+(defun wl-addrbook-alias-next (key alist)
+  (let* ((addrs (nth 1 (wl-addrbook-get-record-by-addr key alist))))
+    (if (and addrs (listp addrs))
+	(wl-get-next addrs key))))
+
+(defun wl-addrbook-alias-add (addr)
+  (if (and (stringp addr) (string-match "@" addr))
+      (let* ((user (wl-address-extract-user addr))
+	     (match-auto (assoc user wl-alias-auto-alist))
+	     (match-adbk (assoc user wl-addrbook-alist)))
+	(cond
+	 (match-auto
+	  (cond
+	   ((equal addr (nth 1 match-auto))
+	    ;; move the entry to the top for the recent-used-first.
+	    (setq wl-alias-auto-alist
+		  (cons match-auto (delete match-auto wl-alias-auto-alist))))
+	   (wl-addrbook-override-by-newone
+	    ;; override match-auto by (user addr)
+	    (setq wl-addrbook-alist
+		  (cons (list user addr)
+			(delete match-auto wl-addrbook-alist)))
+	    (setq wl-alias-auto-alist
+		  (cons (list user addr)
+			(delete match-auto wl-alias-auto-alist))))
+	   (t 
+	    ;; the old entry remains
+	    )))
+	 (match-adbk
+	  ;; do nothing
+	  )
+	 (t
+	  (setq wl-addrbook-alist (cons (list user addr) wl-addrbook-alist))
+	  (setq wl-alias-auto-alist
+		(cons (list user addr) wl-alias-auto-alist)))))))
+
+(defun wl-addrbook-alias-delete (addr)
+  (if (and (stringp addr) (string-match "@" addr))
+      (let* ((user (wl-address-extract-user addr))
+	     (ent (assoc user wl-addrbook-alist)))
+	(if (and ent (equal (cdr ent) addr))
+	    (progn
+	      (setq wl-addrbook-alist (delete ent wl-addrbook-alist))
+	      (setq wl-alias-auto-alist (delete ent wl-alias-auto-alist)))))))
+
+;;
+
+(defun wl-addrbook-shortname-get (addr)
+  (nth 0 (wl-addrbook-get-record-by-addr addr)))
+
+(defun wl-addrbook-nickname-get (addr)
+  (nth 2 (wl-addrbook-get-record-by-addr addr)))
+
+(defun wl-addrbook-name-get (addr)
+  (nth 3 (wl-addrbook-get-record-by-addr addr)))
+;;
+
+(defun wl-addrbook-insert-file (file cregexp &optional unquote)
+  (let* ((case-fold-search t)
+	 (coding-system-for-read wl-cs-autoconv)
+	 (pars (elmo-parse file "\\([^, ]+\\)")) ;; parents
+	 (files pars) ;; included
+	 par chr path beg qchar)
+    ;; include parents files
+    (while pars
+      (setq par (car pars))
+      (setq pars (cdr pars))
+      (if (not (file-readable-p par))
+	  ()
+	(insert-file-contents par)
+	(setq path (file-name-directory par))
+	;; include children files
+	(while (re-search-forward "^\<[ \t]*\\([^ \t\n]+\\).*$" nil t)
+	  (setq chr (expand-file-name (wl-match-buffer 1) path))
+	  (delete-region (match-beginning 0) (match-end 0))
+	  (if (and (file-readable-p chr) (not (member chr files)))
+	      (progn
+		(insert-file-contents chr)
+		(setq files (cons chr files)))))
+	(goto-char (point-max))))
+    ;; remove commets
+    (goto-char (point-min))
+    (while (re-search-forward cregexp nil t)
+      (delete-region (match-beginning 0) (match-end 0)))
+    ;; concat continuation lines
+    (goto-char (point-min))
+    (while (re-search-forward "\\\\\n" nil t)
+      (delete-region (match-beginning 0) (match-end 0)))
+    ;; concat separated lines by comma
+    (goto-char (point-min))
+    (while (re-search-forward ",[ \t]*$" nil t)
+      (end-of-line)
+      (forward-char 1)
+      (delete-backward-char 1)
+      (delete-horizontal-space))
+    ;; unquote, replace white spaces to "\0".
+    (if unquote
+	(catch 'quote
+	  (goto-char (point-min))
+	  (while (re-search-forward "[\"']" nil t)
+	    (setq qchar (char-before (point)))
+	    ;; (point) is for backward compatibility
+	    (backward-delete-char 1) ;; delete quote
+	    (setq beg (point))
+	    (if (not (re-search-forward (char-to-string qchar) nil t))
+		(throw 'quote nil) ;; error
+	      (backward-delete-char 1) ;; delete quote
+	      (save-restriction
+		(narrow-to-region beg (point))
+		(goto-char (point-min))
+		(while (re-search-forward "[ \t]+" nil t)
+		  (replace-match "\0"))
+		(goto-char (point-max))))))) ;; just in case
+    ;; remove optional white spaces
+    (goto-char (point-min))
+    (while (re-search-forward "[ \t]+" nil t)
+      (replace-match " "))))
+
+(defun wl-addrbook-strsafe (var)
+  (if (or (string-equal "" var) (string-equal "*" var))
+      nil
+    (save-match-data
+      (elmo-replace-in-string var (char-to-string 0) " "))))
+
+(defun wl-addrbook-make-alist ()
+  (let (alias colon addrs nick name alist)
+    (wl-set-work-buf
+     (wl-addrbook-insert-file
+      wl-addrbook-file wl-addrbook-comment-regexp 'unquote)
+     (goto-char (point-min))
+     (while (re-search-forward "^ ?\\([^ \n:]+\\) ?\\(:?\\) ?\\([^ \n]+\\)" nil t)
+       (setq alias (wl-addrbook-strsafe (wl-match-buffer 1)))
+       (setq colon (wl-match-buffer 2))
+       (setq addrs (wl-addrbook-strsafe (wl-match-buffer 3)))
+       (if (equal colon ":")
+	   (setq alist (cons (list alias addrs) alist))
+	 (and addrs (setq addrs (elmo-parse addrs "\\([^, \t\r\n]+\\)")))
+	 (if (looking-at " ?\\([^ \n]*\\) ?\\([^ \n]*\\)")
+	     (progn
+	       (setq nick (wl-addrbook-strsafe (wl-match-buffer 1)))
+	       (setq name (wl-addrbook-strsafe (wl-match-buffer 2))))
+	   (setq nick nil)
+	   (setq name nil))
+	 (setq alist (cons (list alias addrs nick name) alist))))
+     (nreverse alist))))
+
+(defun wl-draft-learn-alias ()
+  (interactive)
+  (let ((recipients (mapconcat 'identity 
+			       (delq nil (std11-field-bodies '("To" "Cc")))
+			       ",")))
+    (mapcar '(lambda (addr)
+	       (wl-addrbook-alias-add
+		(wl-address-header-extract-address addr)))
+	    (wl-parse-addresses recipients))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Addrbook mode
+;;;
+
+(defvar wl-addrbook-mode-map nil)
+
+(if wl-addrbook-mode-map
+    ()
+  ;;(setq wl-addrbook-mode-map (make-sparse-keymap))
+  ;;(set-keymap-parent wl-addrbook-mode-map text-mode-map)
+  (setq wl-addrbook-mode-map (copy-keymap text-mode-map))
+  (define-key wl-addrbook-mode-map "\C-c\C-c" 'wl-addrbook-register)
+  (define-key wl-addrbook-mode-map "\C-c\C-q" 'wl-addrbook-kill))
+
+(defvar wl-addrbook-mode-alias "Alias")
+(defvar wl-addrbook-mode-personalinfo "Personal Info")
+(defconst wl-addrbook-buffer-name "*WL Addrbook*")
+
+(defun wl-summary-addrbook-add (&optional personalinfo)
+  "Adding the value of From: or To: in Message mode to Addrbook. When
+executed with '\\[universal-argument]', it will add personal information.  Otherwise,
+it will add an alias."
+  (interactive "P")
+  (wl-summary-redisplay)
+  (let ((buf wl-message-buffer)
+	from shortname address addrs name)
+    (save-excursion
+      (set-buffer buf)
+      (setq address (std11-field-body "From"))
+      (if (wl-address-user-mail-address-p address)
+	  (setq address (std11-field-body "To")))
+      (if (null address)
+	  (message "No address to be registered")
+	(setq addrs (wl-address-header-extract-address address))
+	(if wl-addrbook-strip-domainpart
+	    (setq shortname (wl-address-extract-user addrs))
+	  (setq shortname addrs))
+	(if (string-match "\\(.*\\)<.*>" address)
+	    (progn
+	      (setq name (wl-match-string 1 address))
+	      (setq name (elmo-replace-in-string name "[ \t]$" ""))))
+	(wl-addrbook-prepare-template personalinfo shortname addrs nil name)))))
+
+(defun wl-addrbook-prepare-template (personalinfop shortname addrs &optional nickname name)
+  (delete-other-windows)
+  (switch-to-buffer (get-buffer-create wl-addrbook-buffer-name))
+  (erase-buffer)
+  (insert "#If you want to register this entry, type "
+	  (substitute-command-keys
+	   "'\\<wl-addrbook-mode-map>\\[wl-addrbook-register]'.\n")
+	  "#If you want to NOT register this entry, type "
+	  (substitute-command-keys
+	   "'\\<wl-addrbook-mode-map>\\[wl-addrbook-kill]'.\n"))
+  (wl-addrbook-insert-template "Shortname" shortname)
+  (wl-addrbook-insert-template "Addresses" addrs)
+  (cond
+   (personalinfop
+    (wl-addrbook-insert-template "Nickname" nickname)
+    (wl-addrbook-insert-template "Name" name)
+    (wl-addrbook-mode wl-addrbook-mode-personalinfo))
+   (t
+    (wl-addrbook-mode wl-addrbook-mode-alias)))
+  (wl-addrbook-insert-template "Comments" nil)
+  (goto-char (point-min))
+  (search-forward ": " nil t))
+
+(defun wl-addrbook-insert-template (key val)
+  (let ((buffer-read-only nil)
+	(inhibit-read-only t)
+	(beg (point)))
+    (insert key ": ")
+    (put-text-property beg (point) 'read-only t)
+    (put-text-property (1- (point)) (point)
+		       (if wl-on-xemacs 'end-open 'rear-nonsticky)
+		       t)
+    (and val (insert val))
+    (insert "\n")))
+
+(defun wl-addrbook-mode (mname)
+  "\\<wl-addrbook-mode-map>
+Mew Addrbook mode:: major mode to resistor Addrbook.
+The keys that are defined for this mode are:
+
+\\[wl-addrbook-register]	Register information in Addrbook mode to Addrbook.
+\\[wl-addrbook-kill]	Kill Addrbook mode.
+"
+  (interactive)
+  (setq major-mode 'wl-addrbook-mode)
+  (setq mode-name mname)
+  (setq mode-line-buffer-identification
+	(format "Wanderlust: %s" mname))
+  (use-local-map wl-addrbook-mode-map)
+  (run-hooks 'wl-addrbook-mode-hook)
+  (setq buffer-undo-list nil))
+
+(defun wl-addrbook-register ()
+  "Register information in Addrbook mode to Addrbook."
+  (interactive)
+  (let ((shortname (std11-field-body "Shortname"))
+	(addrs     (std11-field-body "Addresses"))
+	(nickname  (std11-field-body "Nickname"))
+	(name      (std11-field-body "Name"))
+	(comments  (std11-field-body "Comments"))
+	(mode mode-name)
+	buf addrsl errmsg not-uniq)
+     (cond
+      ((equal mode wl-addrbook-mode-alias)
+       (cond
+	((and (null shortname) (null addrs))
+	 (setq errmsg "Must fill both Shortname and Addresses."))
+	((null shortname)
+	 (setq errmsg "Must fill Shortname."))
+	((null addrs)
+	 (setq errmsg "Must fill Addresses."))))
+      (t
+       (cond
+	((null addrs)
+	 (setq errmsg "Must fill Addresses."))
+	((and (null shortname) (null nickname) (null name))
+	 (setq errmsg "Must fill Shortname or Nickname or Name."))
+	((and name (string-match "^\"[^\"]*[^\000-\177]" name))
+	 (setq errmsg "Remove quote around non-ASCII Name.")))))
+     (if errmsg
+	 (message errmsg)
+       (save-excursion
+	 (setq buf (find-file-noselect wl-addrbook-file))
+	 (set-buffer buf)
+	 (goto-char (point-min))
+	 (if (and shortname
+		  (re-search-forward 
+		   (concat "^" (regexp-quote shortname) "[ \t]*:?[ \t]+") nil t))
+	     (setq not-uniq t))
+	 (if not-uniq
+	     () ;; see later
+	   ;; All errors are checked.
+	   (goto-char (point-max))
+	   (if (not (bolp)) (insert "\n"))
+	   (cond
+	    ((equal mode wl-addrbook-mode-alias)
+	     (setq wl-addrbook-alist
+		   (cons (list shortname addrs) wl-addrbook-alist))
+	     (insert shortname ":\t" addrs))
+	    (t
+	     (setq addrsl (wl-address-parse-address-list addrs))
+	     (setq wl-addrbook-alist
+		   (cons (list shortname addrsl nickname name) wl-addrbook-alist))
+	     (if (null shortname) (setq shortname "*"))
+	     (if (and nickname (string-match "^[^\" \t]+[ \t]+.*$" nickname))
+		 (setq nickname (concat "\"" nickname "\"")))
+	     (if (and name (string-match "^[^\" \t]+[ \t]+.*$" name))
+		 (setq name (concat "\"" name "\"")))
+	     (if name
+		 (insert shortname "\t" addrs "\t" (or nickname "*") "\t" name)
+	       (if nickname
+		   (insert shortname "\t" addrs "\t" nickname)
+		 (insert shortname "\t" addrs)))))
+	   (if comments
+	       (insert "\t#" comments "\n")
+	     (insert "\n"))
+	   (save-buffer)))
+       (wl-addrbook-make-hashtb)
+       ;; Addrbook buffer
+       (kill-buffer buf)
+       (if not-uniq
+	   (message "Shortname is already used. Change Shortname.")
+	 (wl-addrbook-kill 'no-msg)
+	 (message "Registered to Addrbook.")))))
+
+(defun wl-addrbook-kill (&optional no-msg)
+  "Kill Addrbook mode."
+  (interactive "P")
+  (kill-buffer (current-buffer))
+  (or no-msg (message "Not registered.")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Show nick name of Addrbook in summary.
+;;;
+
+(defsubst wl-addrbook-get-names (names)
+  (let (addrs)
+    (mapconcat
+     (function
+      (lambda (name)
+	(or (wl-addrbook-nickname-get
+	     (wl-address-header-extract-address name))
+	    (and (setq addrs (std11-extract-address-components name))
+		 (or (car addrs) (cadr addrs))))))
+     (wl-parse-addresses names)
+     ",")))
+
+(eval-when-compile (defvar-maybe entity nil)) ; silence byte compiler.
+(defun wl-summary-addrbook-from (from)
+  "A candidate for wl-summary-from-function.
+Show destination in summary matched by `wl-summary-show-dest-folder-regexp'.
+And use Addrbook for get user name."
+  (let ((fromaddr (wl-address-header-extract-address from))
+	dest)
+    (or
+     (and (eq major-mode 'wl-summary-mode)
+	  (string-match wl-summary-showto-folder-regexp
+			wl-summary-buffer-folder-name)
+	  (wl-address-user-mail-address-p fromaddr)
+	  (cond ((setq dest (elmo-msgdb-overview-entity-get-to entity))
+		 (concat "To:" (eword-decode-string (wl-addrbook-get-names dest))))
+		((setq dest (elmo-msgdb-overview-entity-get-extra-field
+			     entity "newsgroups"))
+		 (concat "Ng:" dest))))
+     (wl-addrbook-nickname-get fromaddr)
+     from)))
+
+(provide 'wl-addrbook)
+
+;;; Copyright Notice:
+
+;; Copyright (C) 1999-2001 Mew developing team.
+;; Copyright (C) 2001 Masahiro Murata <muse@ba2.so-net.ne.jp>
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;; 
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in the
+;;    documentation and/or other materials provided with the distribution.
+;; 3. Neither the name of the team nor the names of its contributors
+;;    may be used to endorse or promote products derived from this software
+;;    without specific prior written permission.
+;; 
+;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
+;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
+;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; wl-addrbook.el ends here
diff --git a/utils/wl-complete.el b/utils/wl-complete.el
new file mode 100644
index 0000000..70dfc68
--- /dev/null
+++ b/utils/wl-complete.el
@@ -0,0 +1,396 @@
+;;; wl-complete.el --- Completion magic for Wanderlust
+
+;; Author:  Masahiro MURATA <muse@ba2.so-net.ne.jp>
+;;	Kazu Yamamoto <Kazu@Mew.org>
+;; Keywords: mail, net news
+
+;;; Commentary:
+
+;;  Insert the following lines in your ~/.wl
+;;
+;; (require 'wl-addrbook)
+;; (wl-addrbook-setup)
+
+;; Original code: Kazu Yamamoto <Kazu@Mew.org>
+;;	mew-complete.el (Mew developing team)
+
+;;; Code:
+
+(require 'wl-util)
+(require 'wl-addrbook)
+
+(defvar wl-mail-domain-list nil)
+(defvar wl-from-list nil)
+
+(defvar wl-complete-lwsp "^[ \t]")
+(defvar wl-complete-address-separator ":, \t\n")
+
+(defvar wl-field-completion-switch
+  '(("To:"       . wl-addrbook-complete-address)
+    ("Cc:"       . wl-addrbook-complete-address)
+    ("Dcc:"      . wl-addrbook-complete-address)
+    ("Bcc:"      . wl-addrbook-complete-address)
+    ("Reply-To:" . wl-addrbook-complete-address)
+    ("Mail-Reply-To:" . wl-addrbook-complete-address)
+    ("Return-Receipt-To:" . wl-addrbook-complete-address)
+    ("Newsgroups:" . wl-complete-newsgroups)
+    ("Followup-To:" . wl-complete-newsgroups)
+    ("Fcc:"      . wl-complete-folder)
+    )
+  "*Completion function alist concerned with the key.")
+
+(defvar wl-field-circular-completion-switch
+  '(("To:"       . wl-circular-complete-domain)
+    ("Cc:"       . wl-circular-complete-domain)
+    ("Dcc:"      . wl-circular-complete-domain)
+    ("Bcc:"      . wl-circular-complete-domain)
+    ("Reply-To:" . wl-circular-complete-domain)
+    ("From:"     . wl-circular-complete-from))
+  "*Circular completion function alist concerned with the key.")
+
+(defvar wl-field-expansion-switch
+  '(("To:"       . wl-addrbook-expand-address)
+    ("Cc:"       . wl-addrbook-expand-address)
+    ("Dcc:"      . wl-addrbook-expand-address)
+    ("Bcc:"      . wl-addrbook-expand-address)
+    ("Reply-To:" . wl-addrbook-expand-address))
+  "*expansion function alist concerned with the key.")
+
+;;; Code:
+
+(defun wl-string-match-assoc (key alist &optional case-ignore)
+  (let (a
+	(case-fold-search case-ignore))
+    (catch 'loop
+      (while alist
+	(setq a (car alist))
+	(if (and (consp a)
+		 (stringp (car a))
+		 (string-match key (car a)))
+	    (throw 'loop a))
+	(setq alist (cdr alist))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Low level functions
+;;;
+
+(defsubst wl-draft-on-header-p ()
+  (< (point)
+     (save-excursion
+       (goto-char (point-min))
+       (search-forward (concat "\n" mail-header-separator "\n") nil 0)
+       (point))))
+
+(defun wl-draft-on-value-p (switch)
+  (if (wl-draft-on-header-p)
+      (save-excursion
+	(beginning-of-line)
+	(while (and (< (point-min) (point)) (looking-at wl-complete-lwsp))
+	  (forward-line -1))
+	(if (looking-at "\\([^:]*:\\)")
+	    (wl-string-match-assoc (wl-match-buffer 1) switch t)
+	  nil)))) ;; what a case reachs here?
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Completion function: C-i
+;;;
+
+(defun wl-draft-addrbook-header-comp-or-tab (force)
+  (interactive "P")
+  (let ((case-fold-search t)
+	func)
+    (if (wl-draft-on-field-p)
+	(wl-complete-field)
+      (if (and
+	   (wl-draft-on-header-p)
+	   (setq func (wl-draft-on-value-p wl-field-completion-switch)))
+	  (funcall (cdr func))
+	(indent-for-tab-command)))))
+
+(defun wl-complete-newsgroups ()
+  (interactive)
+  (wl-complete-field-body wl-folder-newsgroups-hashtb))
+  ;;(wl-address-complete-address wl-folder-newsgroups-hashtb))
+
+(defun wl-complete-folder ()
+  "Folder complete function for Fcc:."
+  (interactive)
+  (let ((word (wl-delete-backward-char)))
+    (if (null word)
+	(wl-complete-window-show (list "+" "%"))
+      (wl-complete word wl-folder-entity-hashtb "folder" nil))))
+
+(defun wl-addrbook-complete-address ()
+  "Complete and expand address aliases. 
+First alias key is completed. When completed solely or the @ character
+is inserted before the cursor, the alias key is expanded to its value."
+  (interactive)
+  (let ((word (wl-delete-backward-char)))
+    (if (null word)
+	(tab-to-tab-stop)
+      (if (string-match "@." word)
+	  (insert (or (wl-alias-next word) word))
+	(wl-complete
+	 word wl-addrbook-alist "alias" ?@ nil nil
+	 (function wl-addrbook-alias-get) 
+	 (function wl-addrbook-alias-hit))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Circular completion: C-cC-i
+;;;
+
+(defun wl-draft-circular-comp ()
+  "Switch function for circular complete functions."
+  (interactive)
+  (let ((func (wl-draft-on-value-p wl-field-circular-completion-switch)))
+    (if func
+	(funcall (cdr func))
+      (message "No circular completion here"))))
+
+(defun wl-circular-complete-domain ()
+  "Circular completion of domains for To:, Cc:, etc.
+If the @ character does not exist, the first value of
+wl-mail-domain-list is inserted. If exists, the next value of 
+wl-mail-domain-list concerned with the string between @ and 
+the cursor is inserted."
+  (interactive)
+  (let ((word (wl-delete-backward-char "@")))
+    (cond
+     ((equal word nil) ;; @ doesn't exist.
+      (if (null wl-mail-domain-list)
+	  (message "For domain circular completion, set wl-mail-domain-list")
+	(insert "@")
+	(insert (car wl-mail-domain-list))
+	(wl-complete-window-delete)))
+     ((equal word t) ;; just after @
+      (if (null wl-mail-domain-list)
+	  (message "For domain circular completion, set wl-mail-domain-list")
+	(insert (car wl-mail-domain-list))
+	(wl-complete-window-delete)))
+     (t
+      ;; can't use wl-get-next since completion is necessary sometime.
+      (wl-complete
+       word
+       (wl-slide-pair wl-mail-domain-list)
+       "domain"
+       t)) ;; use cdr
+     )))
+
+(defun wl-circular-complete (msg clist cname &optional here)
+  "General circular complete function to call wl-complete."
+  (interactive)
+  (let ((str (wl-delete-value here)))
+    (if (null str)
+	(if (car clist)
+	    (insert (car clist))
+	  (message "For circular completion, set %s" cname))
+      (wl-complete
+       str
+       (wl-slide-pair clist)
+       msg
+       t)))) ;; use cdr
+
+(defun wl-circular-complete-from ()
+  "Circular complete function for From:."
+  (interactive)
+  (wl-circular-complete "from" wl-from-list "wl-from-list"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Expansion : M-C-i
+;;;
+
+(defun wl-draft-addrbook-expand ()
+  "Switch function for expand functions."
+  (interactive)
+  (let ((func (wl-draft-on-value-p wl-field-expansion-switch)))
+    (if func
+	(funcall (cdr func))
+      (message "No expansion here"))))
+
+(defun wl-addrbook-expand-address ()
+  "Address expansion fuction for To:, Cc:, etc.
+\"user@domain\" will be expands \"name <user@domain>\" if
+the name exists."
+  (interactive)
+  (let ((word (wl-delete-backward-char)) name)
+    (if (null word)
+	(message "No address here")
+      (setq name (wl-addrbook-name-get word))
+      (insert
+       (if name (format "%s <%s>" name word) word)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Hart function for completions
+;;;
+
+(defun-maybe characterp (form)
+  (numberp form))
+
+(eval-and-compile
+  (fset 'wl-complete-hit (symbol-function 'assoc)))
+
+(defun wl-complete-get (key alist)
+  (cdr (wl-complete-hit key alist)))
+
+(defun wl-complete (WORD ALIST MSG EXPAND-CHAR &optional TRY ALL GET HIT)
+  (let* ((ftry (or TRY (function try-completion)))
+	 (fall (or ALL (function all-completions)))
+	 (fget (or GET (function wl-complete-get)))
+	 (fhit (or HIT (function wl-complete-hit)))
+	 (cmp (funcall ftry WORD ALIST))
+	 (all (funcall fall WORD ALIST))
+	 (len (length WORD))
+	 subkey)
+    (cond
+     ;; already completed
+     ((eq cmp t)
+      (if EXPAND-CHAR ;; may be "t"
+	  (insert (funcall fget WORD ALIST)) ;; use cdr
+	(insert WORD)) ;; use car
+      (wl-complete-window-delete))
+     ;; EXPAND
+     ((and (characterp EXPAND-CHAR)
+	   (char-equal (aref WORD (1- len)) EXPAND-CHAR)
+	   (setq subkey (substring WORD 0 (1- len)))
+	   (funcall fhit subkey ALIST))
+      (insert (funcall fget subkey ALIST)) ;; use cdr
+      (wl-complete-window-delete))
+     ;; just one candidate
+     ((equal 1 (length all))
+      (insert cmp)
+      (wl-complete-window-delete)
+      (if (window-minibuffer-p (get-buffer-window (current-buffer)))
+	  (wl-complete-temp-minibuffer-message " [Sole completion]")
+	(message "Sole completion")))
+     ;; two or more candidates
+     ((stringp cmp) ;; (length all) > 1
+      (insert cmp)
+      (wl-complete-window-show all)
+      (if (and EXPAND-CHAR (funcall fhit cmp ALIST))
+	  (message
+	   (substitute-command-keys
+	    "To expand %s, type %c then '\\<wl-draft-mode-map>\\[wl-draft-addrbook-header-comp-or-tab]'.")
+	   cmp EXPAND-CHAR)))
+     ;; no candidate
+     (t
+      (insert WORD)
+      (if (window-minibuffer-p (get-buffer-window (current-buffer)))
+	  (wl-complete-temp-minibuffer-message (concat " No matching " MSG))
+	(message "No matching %s" MSG))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Minibuf magic
+;;;
+
+(defun wl-complete-temp-minibuffer-message (m)
+  (let ((savemax (point-max)))
+    (save-excursion
+      (goto-char (point-max))
+      (insert m))
+    (let ((inhibit-quit t))
+      (sit-for 2)
+      (delete-region savemax (point-max))
+      (if quit-flag (setq quit-flag nil	unread-command-events 7)))))
+
+;;
+;; Extracting completion key
+;;
+
+(defun wl-delete-backward-char (&optional here)
+  "Delete appropriate preceeding word and return it."
+  (interactive)
+  (let ((case-fold-search t)
+        (start nil)
+        (end (point))
+        (regex (concat "[^" wl-complete-address-separator "]")))
+    (save-excursion
+      (while (and (not (bobp))
+                  (string-match regex (buffer-substring-no-properties
+                                       (1- (point)) (point))))
+        (forward-char -1))
+      (if (and here (not (re-search-forward (regexp-quote here) end t)))
+          nil ;; "here" doesn't exist.
+          (setq start (point))
+          (if (= start end)
+              (if here t nil) ;; just after "here",  just after separator
+            (prog1
+                (buffer-substring-no-properties start end)
+              (delete-region start end)))))))
+
+(defun wl-delete-value (&optional here)
+  (beginning-of-line)
+  (if (not (looking-at "[^:]+:"))
+      ()
+    (goto-char (match-end 0))
+    (if (looking-at "[ \t]")
+	(forward-char 1)
+      (insert " "))
+    (if (eolp)
+	nil
+      (let ((start (point)) ret)
+	(end-of-line)
+	(if (and here (re-search-backward (regexp-quote here) start t))
+	    (progn
+	      (setq start (1+ (point)))
+	      (end-of-line)))
+	(setq ret (buffer-substring-no-properties start (point)))
+	(delete-region start (point))
+	ret))))
+
+;;
+;; Making alist
+;;
+
+(defun wl-slide-pair (x)
+  (let ((ret nil)
+	(first (car x)))
+    (cond 
+     ((eq x 0) nil)
+     ((eq x 1) (cons first first))
+     (t
+      (while (cdr x)
+	(setq ret (cons (cons (nth 0 x) (nth 1 x)) ret))
+	(setq x (cdr x)))
+      (setq ret (cons (cons (car x) first) ret))
+      (nreverse ret)))))
+
+(provide 'wl-complete)
+
+;;; Copyright Notice:
+
+;; Copyright (C) 1997-2001 Mew developing team.
+;; Copyright (C) 2001 Masahiro Murata <muse@ba2.so-net.ne.jp>
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;; 
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in the
+;;    documentation and/or other materials provided with the distribution.
+;; 3. Neither the name of the team nor the names of its contributors
+;;    may be used to endorse or promote products derived from this software
+;;    without specific prior written permission.
+;; 
+;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
+;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
+;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; wl-complete.el ends here