utils/wl-addrbook.el

   1 ;; wl-addrbook.el --- Aliases and personal information
   2
   3 ;; Author:  Masahiro MURATA <muse@ba2.so-net.ne.jp>
   4 ;;      Kazu Yamamoto <Kazu@Mew.org>
   5 ;; Keywords: mail, net news
   6
   7 ;;; Commentary:
   8
   9 ;;  Insert the following lines in your ~/.wl
  10 ;;
  11 ;; (require 'wl-addrbook)
  12 ;; (wl-addrbook-setup)
  13
  14 ;; Original code: Kazu Yamamoto <Kazu@Mew.org>
  15 ;;      mew-addrbook.el (Mew developing team)
  16
  17 ;;; Code:
  18
  19 (require 'wl-util)
  20
  21 (defvar wl-addrbook-file "~/.im/Addrbook"
  22   "*Addrbook file for completion")
  23 (defvar wl-addrbook-expand-max-depth 5
  24   "*A value to limit alias(addrbook) expansion loop.")
  25 (defvar wl-addrbook-comment-regexp "^;.*$\\|#.*$"
  26   "*Regular expression for \".im/Addrbook\".")
  27 (defvar wl-addrbook-override-by-newone t
  28   "If non-nil, the 'user' entry in 'wl-alias-auto-alist'
  29 is override by a new entry of (user different-address).
  30 This means that addresses in To: and Cc: in Draft mode are
  31 always learned with an exception 'user' is defined in Addrbook.
  32 If nil,  the old 'user' entry remains.")
  33
  34 ;;(defvar wl-anonymous-recipients ":;")
  35
  36 (defvar wl-addrbook-hashtb nil)
  37
  38 (defvar wl-addrbook-strip-domainpart t
  39   "*If *non-nil*, a shortname is created by stripping its domain part.")
  40
  41 (defvar wl-addrbook-alist nil
  42   "(key addr) or (key (addr1, addr2) nickname name)")
  43 (defvar wl-alias-auto-alist nil
  44   "(key addr)")
  45 (defvar wl-alias-auto-file-name "auto-alias")
  46
  47 (defvar wl-summary-use-addrbook-from-func t)
  48
  49 ;;; utils
  50
  51 (defun wl-uniq-alist (alst)
  52   "Distractively uniqfy elements of ALST."
  53   (let ((tmp alst))
  54     (while tmp (setq tmp (setcdr tmp (wl-delete-alist2 (car (car tmp)) (cdr tmp))))))
  55   alst)
  56
  57 (defun wl-delete-alist2 (key alist)
  58   "Destructively delete elements whose first member is equal to key"
  59   (if (null key)
  60       alist
  61     (let (ret)
  62       (while (equal (car (nth 0 alist)) key)
  63         (setq alist (cdr alist)))
  64       (setq ret alist)
  65       (while alist
  66         (if (equal (car (nth 1 alist)) key)
  67             (setcdr alist (cdr (cdr alist)))
  68           (setq alist (cdr alist))))
  69       ret)))
  70
  71 (defun wl-get-next (LIST MEM)
  72   (let (frst next crnt)
  73     (setq frst (car LIST))
  74     (setq LIST (cdr LIST))
  75     (setq next (car LIST))
  76     (if (equal frst MEM)
  77         (if next next frst)
  78     (catch 'loop
  79       (while LIST
  80         (setq crnt next)
  81         (setq LIST (cdr LIST))
  82         (setq next (car LIST))
  83         (if (equal crnt MEM)
  84             (throw 'loop (if next next frst))))))))
  85
  86 (defun wl-address-extract-user (addr)
  87   "Extracts username from ADDR"
  88   (if (string-match "@.*:" addr) ;; xxx what's this?
  89       (setq addr (substring addr (match-end 0) nil))
  90     (setq addr (elmo-replace-in-string addr " " "_"))
  91     (setq addr (substring addr 0 (string-match "%" addr)))
  92     (setq addr (substring addr 0 (string-match "@" addr)))
  93     ;; just for refile:  "To: recipients:;" -> recipients
  94     ;;(setq addr (substring addr 0 (string-match wl-anonymous-recipients addr)))
  95     ;; removing Notes domain
  96     (setq addr (substring addr 0 (string-match "/" addr)))))
  97
  98 (defun wl-address-parse-address-list (addrs)
  99   (mapcar 'wl-address-header-extract-address (wl-parse-addresses addrs)))
 100
 101 ;; hash table for wl-addrbook-alist
 102 (defmacro wl-addrbook-hashtb ()
 103   '(or wl-addrbook-hashtb
 104        (setq wl-addrbook-hashtb (elmo-make-hash 1021))))
 105
 106 (defsubst wl-addrbook-get-record-by-addr (addr &optional alist)
 107   (elmo-get-hash-val (downcase addr) (wl-addrbook-hashtb)))
 108
 109 (defsubst wl-addrbook-get-record-by-alias (alias &optional alist)
 110   (elmo-get-hash-val (format "#%s" (downcase alias)) (wl-addrbook-hashtb)))
 111
 112 (defun wl-addrbook-make-hashtb ()
 113   (let ((ht (wl-addrbook-hashtb))
 114         (alist wl-addrbook-alist)
 115         list addrs addr)
 116     (while alist
 117       (setq list (car alist)
 118             alist (cdr alist))
 119       ;; key is alias
 120       (if (car list)
 121           (elmo-set-hash-val (format "#%s" (downcase (car list))) list ht))
 122       (when (listp (setq addrs (nth 1 list)))
 123         (while addrs
 124           (setq addr (car addrs)
 125                 addrs (cdr addrs))
 126           ;; key is address
 127           (elmo-set-hash-val (downcase addr) list ht))))))
 128
 129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 130 ;;;
 131 ;;; Address book
 132 ;;;
 133
 134 (defun wl-addrbook-setup ()
 135   (require 'wl-complete)
 136   ;; replace wl-address-init function.
 137   (setq wl-address-init-function 'wl-addrbook-init)
 138   ;;
 139   (when wl-summary-use-addrbook-from-func
 140     (setq wl-summary-get-petname-function 'wl-addrbook-get-nickname))
 141   (define-key wl-summary-mode-map "\C-c\C-a" 'wl-summary-addrbook-add)
 142   (define-key wl-draft-mode-map "\C-i"     'wl-draft-addrbook-header-comp-or-tab)
 143   (define-key wl-draft-mode-map "\e\t"     'wl-draft-addrbook-expand)
 144   (define-key wl-draft-mode-map "\C-c\t"   'wl-draft-circular-comp)
 145   (add-hook 'mail-send-hook 'wl-draft-learn-alias))
 146
 147 (defun wl-addrbook-init ()
 148   (message "Updating addrbook...")
 149   (or wl-alias-auto-alist
 150       (if wl-alias-auto-file-name
 151           (setq wl-alias-auto-alist
 152                 (elmo-object-load (expand-file-name
 153                                    wl-alias-auto-file-name
 154                                    elmo-msgdb-directory)))))
 155   (setq wl-addrbook-alist (wl-addrbook-make-alist))
 156   ;; wl-alias-auto-alist is used independently so must use copy-alist
 157   (if wl-addrbook-alist
 158       (nconc wl-addrbook-alist (copy-alist wl-alias-auto-alist))
 159     (setq wl-addrbook-alist (copy-alist wl-alias-auto-alist)))
 160 ;;   (if wl-addrbook-alist
 161 ;;       (nconc wl-addrbook-alist (wl-petname-make-alist))
 162 ;;     (setq wl-addrbook-version (wl-petname-make-alist)))
 163   (setq wl-addrbook-alist (wl-uniq-alist wl-addrbook-alist))
 164   (wl-addrbook-make-hashtb)
 165   (add-hook 'kill-emacs-hook (function wl-addrbook-clean-up))
 166   (add-hook 'wl-exit-hook (function wl-addrbook-clean-up))
 167   (message "Updating addrbook...done"))
 168
 169 (defun wl-addrbook-clean-up ()
 170   (remove-hook 'kill-emacs-hook (function wl-addrbook-clean-up))
 171   (remove-hook 'wl-exit-hook (function wl-addrbook-clean-up))
 172   (when wl-alias-auto-file-name
 173     (elmo-object-save (expand-file-name
 174                        wl-alias-auto-file-name
 175                        elmo-msgdb-directory)
 176                       wl-alias-auto-alist)
 177     (setq wl-alias-auto-alist nil)
 178     (setq wl-addrbook-hashtb nil)))
 179
 180 ;;
 181
 182 (defmacro wl-alias-get (key)
 183   `(wl-addrbook-alias-get ,key wl-addrbook-alist))
 184
 185 (defmacro wl-alias-next (key)
 186   `(wl-addrbook-alias-next ,key wl-addrbook-alist))
 187
 188 (defalias 'wl-addrbook-alias-hit 'wl-addrbook-get-record-by-alias)
 189
 190 (defun wl-addrbook-alias-get (key alist)
 191   (let ((addrs (wl-addrbook-alias-get1 key alist 0)))
 192     (cond
 193      ((stringp addrs) addrs)
 194      ((listp addrs)
 195       (mapconcat (lambda (x) x) (nreverse addrs) ", "))
 196      (t key))))
 197
 198 (defun wl-addrbook-alias-get1 (key alist n)
 199   "Expand KEY to addresses according ALIST.
 200 If addresses is a list, that follows one-of convention and
 201 return the first member of the list.
 202 If addresses is a string, expands it recursively."
 203   (let* ((crnt (nth 1 (wl-addrbook-alias-hit key alist)))
 204          (keys (and (stringp crnt)
 205                     (elmo-parse crnt "\\([^, \t]+\\)")))
 206          ret tmp)
 207     (cond
 208      ((> n wl-addrbook-expand-max-depth) key)
 209      ((null crnt) key)
 210      ((listp crnt) (car crnt))
 211      (t
 212       (while keys
 213         (setq tmp (wl-addrbook-alias-get1 (car keys) alist (1+ n)))
 214         (if (listp tmp)
 215             (setq ret (nconc tmp ret))
 216           (setq ret (cons tmp ret)))
 217         (setq keys (cdr keys)))
 218       ret))))
 219
 220 (defun wl-addrbook-alias-next (key alist)
 221   (let* ((addrs (nth 1 (wl-addrbook-get-record-by-addr key alist))))
 222     (if (and addrs (listp addrs))
 223         (wl-get-next addrs key))))
 224
 225 (defun wl-addrbook-alias-add (addr)
 226   (if (and (stringp addr) (string-match "@" addr))
 227       (let* ((user (wl-address-extract-user addr))
 228              (match-auto (assoc user wl-alias-auto-alist))
 229              (match-adbk (assoc user wl-addrbook-alist)))
 230         (cond
 231          (match-auto
 232           (cond
 233            ((equal addr (nth 1 match-auto))
 234             ;; move the entry to the top for the recent-used-first.
 235             (setq wl-alias-auto-alist
 236                   (cons match-auto (delete match-auto wl-alias-auto-alist))))
 237            (wl-addrbook-override-by-newone
 238             ;; override match-auto by (user addr)
 239             (setq wl-addrbook-alist
 240                   (cons (list user addr)
 241                         (delete match-auto wl-addrbook-alist)))
 242             (setq wl-alias-auto-alist
 243                   (cons (list user addr)
 244                         (delete match-auto wl-alias-auto-alist))))
 245            (t
 246             ;; the old entry remains
 247             )))
 248          (match-adbk
 249           ;; do nothing
 250           )
 251          (t
 252           (setq wl-addrbook-alist (cons (list user addr) wl-addrbook-alist))
 253           (setq wl-alias-auto-alist
 254                 (cons (list user addr) wl-alias-auto-alist)))))))
 255
 256 (defun wl-addrbook-alias-delete (addr)
 257   (if (and (stringp addr) (string-match "@" addr))
 258       (let* ((user (wl-address-extract-user addr))
 259              (ent (assoc user wl-addrbook-alist)))
 260         (if (and ent (equal (cdr ent) addr))
 261             (progn
 262               (setq wl-addrbook-alist (delete ent wl-addrbook-alist))
 263               (setq wl-alias-auto-alist (delete ent wl-alias-auto-alist)))))))
 264
 265 ;;
 266
 267 (defun wl-addrbook-shortname-get (addr)
 268   (nth 0 (wl-addrbook-get-record-by-addr addr)))
 269
 270 (defun wl-addrbook-nickname-get (addr)
 271   (nth 2 (wl-addrbook-get-record-by-addr addr)))
 272
 273 (defun wl-addrbook-name-get (addr)
 274   (nth 3 (wl-addrbook-get-record-by-addr addr)))
 275 ;;
 276
 277 (defun wl-addrbook-insert-file (file cregexp &optional unquote)
 278   (let* ((case-fold-search t)
 279          (coding-system-for-read wl-cs-autoconv)
 280          (pars (elmo-parse file "\\([^, ]+\\)")) ;; parents
 281          (files pars) ;; included
 282          par chr path beg qchar)
 283     ;; include parents files
 284     (while pars
 285       (setq par (car pars))
 286       (setq pars (cdr pars))
 287       (if (not (file-readable-p par))
 288           ()
 289         (insert-file-contents par)
 290         (setq path (file-name-directory par))
 291         ;; include children files
 292         (while (re-search-forward "^\<[ \t]*\\([^ \t\n]+\\).*$" nil t)
 293           (setq chr (expand-file-name (wl-match-buffer 1) path))
 294           (delete-region (match-beginning 0) (match-end 0))
 295           (if (and (file-readable-p chr) (not (member chr files)))
 296               (progn
 297                 (insert-file-contents chr)
 298                 (setq files (cons chr files)))))
 299         (goto-char (point-max))))
 300     ;; remove commets
 301     (goto-char (point-min))
 302     (while (re-search-forward cregexp nil t)
 303       (delete-region (match-beginning 0) (match-end 0)))
 304     ;; concat continuation lines
 305     (goto-char (point-min))
 306     (while (re-search-forward "\\\\\n" nil t)
 307       (delete-region (match-beginning 0) (match-end 0)))
 308     ;; concat separated lines by comma
 309     (goto-char (point-min))
 310     (while (re-search-forward ",[ \t]*$" nil t)
 311       (end-of-line)
 312       (forward-char 1)
 313       (delete-char -1)
 314       (delete-horizontal-space))
 315     ;; unquote, replace white spaces to "\0".
 316     (if unquote
 317         (catch 'quote
 318           (goto-char (point-min))
 319           (while (re-search-forward "[\"']" nil t)
 320             (setq qchar (char-before (point)))
 321             ;; (point) is for backward compatibility
 322             (delete-char -1)            ; delete quote
 323             (setq beg (point))
 324             (if (not (re-search-forward (char-to-string qchar) nil t))
 325                 (throw 'quote nil) ;; error
 326               (delete-char -1)     ; delete quote
 327               (save-restriction
 328                 (narrow-to-region beg (point))
 329                 (goto-char (point-min))
 330                 (while (re-search-forward "[ \t]+" nil t)
 331                   (replace-match "\0"))
 332                 (goto-char (point-max))))))) ;; just in case
 333     ;; remove optional white spaces
 334     (goto-char (point-min))
 335     (while (re-search-forward "[ \t]+" nil t)
 336       (replace-match " "))))
 337
 338 (defun wl-addrbook-strsafe (var)
 339   (if (or (string-equal "" var) (string-equal "*" var))
 340       nil
 341     (save-match-data
 342       (elmo-replace-in-string var (char-to-string 0) " "))))
 343
 344 (defun wl-addrbook-make-alist ()
 345   (let (alias colon addrs nick name alist)
 346     (wl-set-work-buf
 347      (wl-addrbook-insert-file
 348       wl-addrbook-file wl-addrbook-comment-regexp 'unquote)
 349      (goto-char (point-min))
 350      (while (re-search-forward "^ ?\\([^ \n:]+\\) ?\\(:?\\) ?\\([^ \n]+\\)" nil t)
 351        (setq alias (wl-addrbook-strsafe (wl-match-buffer 1)))
 352        (setq colon (wl-match-buffer 2))
 353        (setq addrs (wl-addrbook-strsafe (wl-match-buffer 3)))
 354        (if (equal colon ":")
 355            (setq alist (cons (list alias addrs) alist))
 356          (and addrs (setq addrs (elmo-parse addrs "\\([^, \t\r\n]+\\)")))
 357          (if (looking-at " ?\\([^ \n]*\\) ?\\([^ \n]*\\)")
 358              (progn
 359                (setq nick (wl-addrbook-strsafe (wl-match-buffer 1)))
 360                (setq name (wl-addrbook-strsafe (wl-match-buffer 2))))
 361            (setq nick nil)
 362            (setq name nil))
 363          (setq alist (cons (list alias addrs nick name) alist))))
 364      (nreverse alist))))
 365
 366 (defun wl-draft-learn-alias ()
 367   (interactive)
 368   (let ((recipients (mapconcat 'identity
 369                                (delq nil (std11-field-bodies '("To" "Cc")))
 370                                ",")))
 371     (mapcar '(lambda (addr)
 372                (wl-addrbook-alias-add
 373                 (wl-address-header-extract-address addr)))
 374             (wl-parse-addresses recipients))))
 375
 376 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 377 ;;;
 378 ;;; Addrbook mode
 379 ;;;
 380
 381 (defvar wl-addrbook-mode-map nil)
 382
 383 (if wl-addrbook-mode-map
 384     ()
 385   ;;(setq wl-addrbook-mode-map (make-sparse-keymap))
 386   ;;(set-keymap-parent wl-addrbook-mode-map text-mode-map)
 387   (setq wl-addrbook-mode-map (copy-keymap text-mode-map))
 388   (define-key wl-addrbook-mode-map "\C-c\C-c" 'wl-addrbook-register)
 389   (define-key wl-addrbook-mode-map "\C-c\C-q" 'wl-addrbook-kill))
 390
 391 (defvar wl-addrbook-mode-alias "Alias")
 392 (defvar wl-addrbook-mode-personalinfo "Personal Info")
 393 (defconst wl-addrbook-buffer-name "*WL Addrbook*")
 394
 395 (defun wl-summary-addrbook-add (&optional personalinfo)
 396   "Adding the value of From: or To: in Message mode to Addrbook. When
 397 executed with '\\[universal-argument]', it will add personal information.  Otherwise,
 398 it will add an alias."
 399   (interactive "P")
 400   (wl-summary-redisplay)
 401   (let ((buf wl-message-buffer)
 402         from shortname address addrs name)
 403     (with-current-buffer buf
 404       (setq address (std11-field-body "From"))
 405       (if (wl-address-user-mail-address-p address)
 406           (setq address (std11-field-body "To")))
 407       (if (null address)
 408           (message "No address to be registered")
 409         (setq addrs (wl-address-header-extract-address address))
 410         (if wl-addrbook-strip-domainpart
 411             (setq shortname (wl-address-extract-user addrs))
 412           (setq shortname addrs))
 413         (if (string-match "\\(.*\\)<.*>" address)
 414             (progn
 415               (setq name (wl-match-string 1 address))
 416               (setq name (elmo-replace-in-string name "[ \t]$" ""))))
 417         (wl-addrbook-prepare-template personalinfo shortname addrs nil name)))))
 418
 419 (defun wl-addrbook-prepare-template (personalinfop shortname addrs &optional nickname name)
 420   (delete-other-windows)
 421   (switch-to-buffer (get-buffer-create wl-addrbook-buffer-name))
 422   (erase-buffer)
 423   (insert "#If you want to register this entry, type "
 424           (substitute-command-keys
 425            "'\\<wl-addrbook-mode-map>\\[wl-addrbook-register]'.\n")
 426           "#If you want to NOT register this entry, type "
 427           (substitute-command-keys
 428            "'\\<wl-addrbook-mode-map>\\[wl-addrbook-kill]'.\n"))
 429   (wl-addrbook-insert-template "Shortname" shortname)
 430   (wl-addrbook-insert-template "Addresses" addrs)
 431   (cond
 432    (personalinfop
 433     (wl-addrbook-insert-template "Nickname" nickname)
 434     (wl-addrbook-insert-template "Name" name)
 435     (wl-addrbook-mode wl-addrbook-mode-personalinfo))
 436    (t
 437     (wl-addrbook-mode wl-addrbook-mode-alias)))
 438   (wl-addrbook-insert-template "Comments" nil)
 439   (goto-char (point-min))
 440   (search-forward ": " nil t))
 441
 442 (defun wl-addrbook-insert-template (key val)
 443   (let ((buffer-read-only nil)
 444         (inhibit-read-only t)
 445         (beg (point)))
 446     (insert key ": ")
 447     (put-text-property beg (point) 'read-only t)
 448     (put-text-property (1- (point)) (point)
 449                        (if wl-on-xemacs 'end-open 'rear-nonsticky)
 450                        t)
 451     (and val (insert val))
 452     (insert "\n")))
 453
 454 (defun wl-addrbook-mode (mname)
 455   "\\<wl-addrbook-mode-map>
 456 Mew Addrbook mode:: major mode to resistor Addrbook.
 457 The keys that are defined for this mode are:
 458
 459 \\[wl-addrbook-register]        Register information in Addrbook mode to Addrbook.
 460 \\[wl-addrbook-kill]    Kill Addrbook mode.
 461 "
 462   (interactive)
 463   (setq major-mode 'wl-addrbook-mode)
 464   (setq mode-name mname)
 465   (setq mode-line-buffer-identification
 466         (format "Wanderlust: %s" mname))
 467   (use-local-map wl-addrbook-mode-map)
 468   (run-hooks 'wl-addrbook-mode-hook)
 469   (setq buffer-undo-list nil))
 470
 471 (defun wl-addrbook-register ()
 472   "Register information in Addrbook mode to Addrbook."
 473   (interactive)
 474   (let ((shortname (std11-field-body "Shortname"))
 475         (addrs     (std11-field-body "Addresses"))
 476         (nickname  (std11-field-body "Nickname"))
 477         (name      (std11-field-body "Name"))
 478         (comments  (std11-field-body "Comments"))
 479         (mode mode-name)
 480         buf addrsl errmsg not-uniq)
 481      (cond
 482       ((equal mode wl-addrbook-mode-alias)
 483        (cond
 484         ((and (null shortname) (null addrs))
 485          (setq errmsg "Must fill both Shortname and Addresses."))
 486         ((null shortname)
 487          (setq errmsg "Must fill Shortname."))
 488         ((null addrs)
 489          (setq errmsg "Must fill Addresses."))))
 490       (t
 491        (cond
 492         ((null addrs)
 493          (setq errmsg "Must fill Addresses."))
 494         ((and (null shortname) (null nickname) (null name))
 495          (setq errmsg "Must fill Shortname or Nickname or Name."))
 496         ((and name (string-match "^\"[^\"]*[^\000-\177]" name))
 497          (setq errmsg "Remove quote around non-ASCII Name.")))))
 498      (if errmsg
 499          (message errmsg)
 500        (save-excursion
 501          (setq buf (find-file-noselect wl-addrbook-file))
 502          (set-buffer buf)
 503          (goto-char (point-min))
 504          (if (and shortname
 505                   (re-search-forward
 506                    (concat "^" (regexp-quote shortname) "[ \t]*:?[ \t]+") nil t))
 507              (setq not-uniq t))
 508          (if not-uniq
 509              () ;; see later
 510            ;; All errors are checked.
 511            (goto-char (point-max))
 512            (if (not (bolp)) (insert "\n"))
 513            (cond
 514             ((equal mode wl-addrbook-mode-alias)
 515              (setq wl-addrbook-alist
 516                    (cons (list shortname addrs) wl-addrbook-alist))
 517              (insert shortname ":\t" addrs))
 518             (t
 519              (setq addrsl (wl-address-parse-address-list addrs))
 520              (setq wl-addrbook-alist
 521                    (cons (list shortname addrsl nickname name) wl-addrbook-alist))
 522              (if (null shortname) (setq shortname "*"))
 523              (if (and nickname (string-match "^[^\" \t]+[ \t]+.*$" nickname))
 524                  (setq nickname (concat "\"" nickname "\"")))
 525              (if (and name (string-match "^[^\" \t]+[ \t]+.*$" name))
 526                  (setq name (concat "\"" name "\"")))
 527              (if name
 528                  (insert shortname "\t" addrs "\t" (or nickname "*") "\t" name)
 529                (if nickname
 530                    (insert shortname "\t" addrs "\t" nickname)
 531                  (insert shortname "\t" addrs)))))
 532            (if comments
 533                (insert "\t#" comments "\n")
 534              (insert "\n"))
 535            (save-buffer)))
 536        (wl-addrbook-make-hashtb)
 537        ;; Addrbook buffer
 538        (kill-buffer buf)
 539        (if not-uniq
 540            (message "Shortname is already used. Change Shortname.")
 541          (wl-addrbook-kill 'no-msg)
 542          (message "Registered to Addrbook.")))))
 543
 544 (defun wl-addrbook-kill (&optional no-msg)
 545   "Kill Addrbook mode."
 546   (interactive "P")
 547   (kill-buffer (current-buffer))
 548   (or no-msg (message "Not registered.")))
 549
 550 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 551 ;;;
 552 ;;; Show nick name of Addrbook in summary.
 553 ;;;
 554
 555 (defun wl-addrbook-get-nickname (mailbox)
 556   "For `wl-summary-get-petname-function'."
 557   (wl-addrbook-nickname-get
 558    (wl-address-header-extract-address mailbox)))
 559
 560 (provide 'wl-addrbook)
 561
 562 ;;; Copyright Notice:
 563
 564 ;; Copyright (C) 1999-2001 Mew developing team.
 565 ;; Copyright (C) 2001 Masahiro Murata <muse@ba2.so-net.ne.jp>
 566 ;; All rights reserved.
 567
 568 ;; Redistribution and use in source and binary forms, with or without
 569 ;; modification, are permitted provided that the following conditions
 570 ;; are met:
 571 ;;
 572 ;; 1. Redistributions of source code must retain the above copyright
 573 ;;    notice, this list of conditions and the following disclaimer.
 574 ;; 2. Redistributions in binary form must reproduce the above copyright
 575 ;;    notice, this list of conditions and the following disclaimer in the
 576 ;;    documentation and/or other materials provided with the distribution.
 577 ;; 3. Neither the name of the team nor the names of its contributors
 578 ;;    may be used to endorse or promote products derived from this software
 579 ;;    without specific prior written permission.
 580 ;;
 581 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
 582 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 583 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 584 ;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
 585 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 586 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 587 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 588 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 589 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 590 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 591 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 592
 593 ;;; wl-addrbook.el ends here