1 ;;; wl-address.el --- Tiny address management for Wanderlust.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 1998,1999,2000 Shun-ichi GOTO <gotoh@taiyo.co.jp>
5 ;; Copyright (C) 1998,1999,2000 Takeshi Chiba <chiba@d3.bs1.fc.nec.co.jp>
7 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
8 ;; Shun-ichi GOTO <gotoh@taiyo.co.jp>
9 ;; Takeshi Chiba <chiba@d3.bs1.fc.nec.co.jp>
10 ;; Keywords: mail, net news
12 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
14 ;; This program is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
40 (defvar wl-address-complete-header-list
41 '("To:" "From:" "Cc:" "Bcc:" "Mail-Followup-To:" "Reply-To:"
42 "Return-Receipt-To:"))
43 (defvar wl-address-complete-header-regexp nil) ; auto-generated.
44 (defvar wl-newsgroups-complete-header-regexp "^\\(Newsgroups\\|Followup-To\\):")
45 (defvar wl-folder-complete-header-regexp "^\\(Fcc\\):")
46 (defvar wl-address-list nil)
47 (defvar wl-address-completion-list nil)
48 (defvar wl-address-petname-hash nil)
49 (defvar wl-address-enable-strict-loading t)
51 (defvar wl-address-ldap-search-hash nil)
53 (eval-when-compile (require 'pldap))
55 (defvar wl-ldap-alias-dn-level nil
56 "Level of dn data to make alias postfix.
57 Valid value is nit, t, 1 or larget integer.
59 If this value nil, minimum alias postfix is made depends on uniqness
60 with other candidates. In this implementation, it's same to 1. If t,
61 always append all dn data. If number, always append spcified level of
62 data but maybe appended more uniqness. If invalid value, treat as
65 For example, following dn data is exsist, alias of each level is shown
69 dn: CN=Shun-ichi GOTO,OU=Mew,OU=Emacs,OU=Lisper,O=Programmers Inc.
70 nil => Goto/Shun-ichi_GOTO
71 1 => Goto/Shun-ichi_GOTO
72 2 => Goto/Shun-ichi_GOTO/Mew
73 3 => Goto/Shun-ichi_GOTO/Mew/Emacs
74 4 => Goto/Shun-ichi_GOTO/Mew/Emacs/Lisper
75 5 => Goto/Shun-ichi_GOTO/Mew/Emacs/Lisper/Programmers_Inc_
76 6 => Goto/Shun-ichi_GOTO/Mew/Emacs/Lisper/Programmers_Inc_
77 t => Goto/Shun-ichi_GOTO/Mew/Emacs/Lisper/Programmers_Inc_
79 If level 3 is required for uniqness with other candidates,
80 nil => Goto/Shun-ichi_GOTO/Mew/Emacs ... appended more
81 1 => Goto/Shun-ichi_GOTO/Mew/Emacs ... appended more
82 2 => Goto/Shun-ichi_GOTO/Mew/Emacs ... appended more
83 3 => Goto/Shun-ichi_GOTO/Mew/Emacs
84 4 => Goto/Shun-ichi_GOTO/Mew/Emacs/Lisper
87 (defconst wl-ldap-alias-sep "/")
89 (defconst wl-ldap-search-attribute-type-list
90 '("sn" "cn" "mail" "email"))
92 (defun wl-ldap-get-value (type entry)
94 (let* ((values (cdr (assoc type entry)))
96 (if (and ret (not ldap-ignore-attribute-codings))
98 (if (not (string-match "^[\000-\177]*$" (car values)))
99 (setq ret (car values)
101 (setq values (cdr values)))))
104 (defun wl-ldap-get-value-list (type entry)
106 (cdr (assoc type entry)))
108 (defun wl-ldap-make-filter (pat type-list)
109 "Make RFC1558 quiery filter for PAT from ATTR-LIST.
110 Each are \"OR\" combination, and PAT is beginning-match."
112 (mapconcat (lambda (x) (format "(%s=%s*)" x pat)) ; fixed format
117 (defun wl-ldap-make-matched-value-list (regexp type-list entry)
118 "Correct matching WORD with value of TYPE-LIST in ENTRY.
119 Returns matched uniq string list."
120 (let (type val values result)
121 ;; collect matching value
123 (setq type (car (car entry))
124 values (mapcar (function wl-ldap-alias-safe-string)
126 values (elmo-flatten values)
128 (if (member type type-list)
130 (setq val (car values)
132 (if (and (string-match regexp val)
133 (not (member val result)))
134 (setq result (cons val result))))))
137 (defun wl-ldap-alias-safe-string (str)
138 "Modify STR for alias.
139 Replace space/tab in STR into '_' char.
140 Replace '@' in STR into list of mailbox and sub-domains."
141 (while (string-match "[ \t]+" str)
142 (setq str (concat (substring str 0 (match-beginning 0))
144 (substring str (match-end 0)))))
145 (if (string-match "\\(@\\)[^/@]+" str)
146 (setq str (split-string str "[@\\.]")))
149 (defun wl-ldap-register-dn-string (hash dn &optional str dn-list)
151 (let (sym dnsym value level)
152 (setq dnsym (intern (upcase dn) hash))
153 (if (and (null str) (boundp dnsym))
154 () ; already processed
155 ;; make dn-list in fisrt time
157 (let ((case-fold-search t))
158 (setq dn-list (mapcar (lambda (str)
159 (if (string-match "[a-z]+=\\(.*\\)" str)
160 (wl-ldap-alias-safe-string
161 (wl-match-string 1 str))))
162 (split-string dn "[ \t]*,[ \t]*")))))
163 (setq dn-list (elmo-flatten dn-list))
164 ;; prepare candidate for uniq str
166 (setq str (concat str wl-ldap-alias-sep (car dn-list))
167 dn-list (cdr dn-list))
168 ;; first entry, pre-build with given level
170 ((null wl-ldap-alias-dn-level) (setq level 1))
171 ((eq t wl-ldap-alias-dn-level) (setq level 1000)) ; xxx, big enough
172 ((numberp wl-ldap-alias-dn-level)
173 (if (< 0 wl-ldap-alias-dn-level)
174 (setq level wl-ldap-alias-dn-level)
178 (while (and (< 0 level) dn-list)
180 (setq str (car dn-list))
181 (setq str (concat str wl-ldap-alias-sep (car dn-list))))
182 (setq level (1- level)
183 dn-list (cdr dn-list))))
184 (setq sym (intern (upcase str) hash))
185 (if (not (boundp sym))
187 (progn (set sym (list dn str dn-list))
190 (if (not (eq (setq value (symbol-value sym)) t))
193 (apply (function wl-ldap-register-dn-string) hash value)))
194 (wl-ldap-register-dn-string hash dn str dn-list)))))
196 (defun wl-address-ldap-search (pattern cl)
197 "Make address completion-list matched for PATTERN by LDAP search.
198 Matched address lists are append to CL."
200 (unless wl-address-ldap-search-hash
201 (setq wl-address-ldap-search-hash (elmo-make-hash 7)))
202 (let ((pat (if (string-match wl-ldap-alias-sep pattern)
203 (substring pattern 0 (match-beginning 0))
205 (ldap-default-host (or wl-ldap-server ldap-default-host "localhost"))
206 (ldap-default-port (or wl-ldap-port ldap-default-port 389))
207 (ldap-default-base (or wl-ldap-base ldap-default-base))
208 (dnhash (elmo-make-hash))
209 cache len sym tmpl regexp entries ent values dn dnstr alias
212 (mapatoms (lambda (atom)
213 (if (and (string-match
214 (concat "^" (symbol-name atom) ".*") pat)
217 (setq len (length (symbol-name atom))))))
219 (or len (length (symbol-name atom)))
220 (symbol-value atom)))))
221 wl-address-ldap-search-hash)
222 ;; get matched entries
224 (setq entries (cdr cache))
226 (message "Searching in LDAP...")
227 (setq entries (ldap-search-entries
229 pat wl-ldap-search-attribute-type-list)
230 nil wl-ldap-search-attribute-type-list nil t))
231 (message "Searching in LDAP...done")
232 (elmo-set-hash-val pattern entries wl-address-ldap-search-hash)))
236 (wl-ldap-register-dn-string dnhash (car (car tmpl))) ; car is 'dn'.
237 (setq tmpl (cdr tmpl)))
239 (setq regexp (concat "^" pat))
241 (setq ent (cdar entries)
242 values (wl-ldap-make-matched-value-list
243 regexp wl-ldap-search-attribute-type-list
245 mails (or (wl-ldap-get-value-list "mail" ent)
246 (wl-ldap-get-value-list "email" ent))
247 cn (wl-ldap-get-value "cn" ent)
248 dn (car (car entries))
249 dnstr (elmo-get-hash-val (upcase dn) dnhash))
250 ;; make alias list generated from LDAP data.
251 (while (and mails values)
252 ;; make alias like MATCHED/DN-STRING
253 (if (not (string-match (concat "^" (regexp-quote (car values))) dnstr))
254 (setq alias (concat (car values) wl-ldap-alias-sep dnstr))
255 ;; use DN-STRING if DN-STRING begin with MATCHED
257 ;; check uniqness then add to list
258 (setq sym (intern (downcase alias) dnhash))
259 (when (not (boundp sym))
261 (setq result (cons (cons alias
262 (concat cn " <" (car mails) ">"))
264 (setq values (cdr values)))
265 ;; make mail addrses list
267 (if (null (assoc (car mails) cl)); Not already in cl.
268 ;; (string-match regexp (car mails))
269 ;; add mail address itself to completion list
270 (setq result (cons (cons (car mails)
271 (concat cn " <" (car mails) ">"))
273 (setq mails (cdr mails)))
274 (setq entries (cdr entries)))
277 (defun wl-complete-address (string predicate flag)
278 "Completion function for completing-read (comma separated addresses)."
279 (if (string-match "^\\(.*,\\)\\(.*\\)$" string)
280 (let* ((str1 (match-string 1 string))
281 (str2 (match-string 2 string))
282 (str2-comp (wl-complete-address str2 predicate flag)))
283 (if (and (not flag) (stringp str2-comp))
284 (concat str1 str2-comp)
287 (try-completion string wl-address-list)
288 (all-completions string wl-address-list))))
290 (defalias 'wl-address-quote-specials 'elmo-address-quote-specials)
292 (defun wl-address-make-completion-list (address-list)
295 (setq addr-tuple (car address-list))
298 (wl-address-make-completion-entry 0 addr-tuple)
300 ;; nickname completion.
301 (if wl-address-enable-strict-loading
302 (unless (or (equal (nth 1 addr-tuple) (nth 0 addr-tuple))
304 (assoc (nth 1 addr-tuple) cl))
307 (wl-address-make-completion-entry 1 addr-tuple)
311 (wl-address-make-completion-entry 1 addr-tuple)
313 (setq address-list (cdr address-list)))
316 (defun wl-address-make-completion-entry (index addr-tuple)
317 (cons (nth index addr-tuple)
318 (if (or (string= (nth 2 addr-tuple) "")
319 (string-match ".*:.*;$" (nth 0 addr-tuple)))
322 (wl-address-quote-specials
323 (nth 2 addr-tuple)) " <"(nth 0 addr-tuple)">"))))
325 (defun wl-complete-field-body-or-tab ()
327 (let ((case-fold-search t)
328 epand-char skip-chars
331 (if (wl-draft-on-field-p)
336 (goto-char (point-min))
337 (search-forward (concat "\n" mail-header-separator "\n") nil 0)
342 (while (and (looking-at "^[ \t]")
343 (not (= (point) (point-min))))
345 (cond ((looking-at wl-address-complete-header-regexp)
346 (setq completion-list wl-address-completion-list)
349 (setq epand-char ?@))
350 ((looking-at wl-folder-complete-header-regexp)
351 (setq completion-list wl-folder-entity-hashtb)
352 (setq skip-chars "^, "))
353 ((looking-at wl-newsgroups-complete-header-regexp)
354 (setq completion-list wl-folder-newsgroups-hashtb)))))
355 (wl-complete-field-body completion-list
356 epand-char skip-chars use-ldap)
357 (indent-for-tab-command)))))
359 (defvar wl-completion-buf-name "*Completions*")
361 (defvar wl-complete-candidates nil)
363 (defun wl-complete-window-show (all)
364 (if (and (get-buffer-window wl-completion-buf-name)
365 (equal wl-complete-candidates all))
366 (let ((win (get-buffer-window wl-completion-buf-name)))
368 (set-buffer wl-completion-buf-name)
369 (if (pos-visible-in-window-p (point-max) win)
370 (set-window-start win 1)
371 (scroll-other-window))))
372 (message "Making completion list...")
373 (setq wl-complete-candidates all)
374 (with-output-to-temp-buffer
375 wl-completion-buf-name
376 (display-completion-list all))
377 (message "Making completion list...done")))
379 (defun wl-complete-window-delete ()
380 (let (comp-buf comp-win)
381 (if (setq comp-buf (get-buffer wl-completion-buf-name))
382 (if (setq comp-win (get-buffer-window comp-buf))
383 (delete-window comp-win)))))
385 (defun wl-complete-field ()
388 (start (save-excursion
389 (skip-chars-backward "_a-zA-Z0-9+@%.!\\-")
392 (pattern (buffer-substring start end))
393 (cl wl-draft-field-completion-list))
397 (let ((completion-ignore-case t))
398 (try-completion pattern cl)))
399 (cond ((eq completion t)
400 (let ((alias (assoc pattern cl)))
403 (delete-region start end)
405 ;;; (wl-highlight-message (point-min)(point-max) t)
407 (wl-complete-window-delete))
409 (message "Can't find completion for \"%s\"" pattern)
411 ((not (string= pattern completion))
412 (delete-region start end)
414 (wl-complete-window-delete)
415 (wl-highlight-message (point-min)(point-max) t))
417 (let ((list (all-completions pattern cl)))
418 (wl-complete-window-show list)))))))
420 (defun wl-complete-insert (start end pattern completion-list)
421 (let ((alias (and (consp completion-list)
422 (assoc pattern completion-list)))
426 (delete-region start end)
428 (if (setq comp-buf (get-buffer wl-completion-buf-name))
429 (if (setq comp-win (get-buffer-window comp-buf))
430 (delete-window comp-win)))))))
432 (defun wl-complete-field-body (completion-list
433 &optional epand-char skip-chars use-ldap)
436 (start (save-excursion
437 (skip-chars-backward (or skip-chars "^:,>\n"))
438 (skip-chars-forward " \t")
441 (pattern (buffer-substring start end))
442 (len (length pattern))
443 (completion-ignore-case t)
444 (cl completion-list))
446 (setq cl (wl-address-ldap-search pattern cl)))
449 (setq completion (try-completion pattern cl))
450 (cond ((eq completion t)
451 (if use-ldap (setq wl-address-ldap-search-hash nil))
452 (wl-complete-insert start end pattern cl)
453 (wl-complete-window-delete)
454 (message "Sole completion"))
457 (or (char-equal (aref pattern (1- len)) epand-char)
458 (char-equal (aref pattern (1- len)) ?\ ))
459 (assoc (substring pattern 0 (1- len)) cl))
462 (substring pattern 0 (1- len))
465 (message "Can't find completion for \"%s\"" pattern)
467 ((not (string= pattern completion))
468 (delete-region start end)
471 (let ((list (sort (all-completions pattern cl) 'string<)))
472 (wl-complete-window-show list)))))))
474 (defvar wl-address-init-function 'wl-local-address-init)
476 (defun wl-address-init ()
477 "Call `wl-address-init-function'."
478 (funcall wl-address-init-function))
480 (defun wl-local-address-init ()
481 "Reload `wl-address-file'.
482 Refresh `wl-address-list', `wl-address-completion-list', and
483 `wl-address-petname-hash'."
484 (message "Updating addresses...")
485 (setq wl-address-list
486 (wl-address-make-address-list wl-address-file))
487 (setq wl-address-completion-list
488 (wl-address-make-completion-list wl-address-list))
489 (if (file-readable-p wl-alias-file)
490 (setq wl-address-completion-list
491 (append wl-address-completion-list
492 (wl-address-make-alist-from-alias-file wl-alias-file))))
493 (setq wl-address-petname-hash (elmo-make-hash))
494 (let ((addresses wl-address-list))
496 (elmo-set-hash-val (downcase (car (car addresses)))
497 (cadr (car addresses))
498 wl-address-petname-hash)
499 (setq addresses (cdr addresses))))
500 (message "Updating addresses...done"))
503 (defun wl-address-expand-aliases (alist nest-count)
504 (when (< nest-count 5)
505 (let (expn-str new-expn-str expn new-expn(n 0) (expanded nil))
506 (while (setq expn-str (cdr (nth n alist)))
507 (setq new-expn-str nil)
508 (while (string-match "^[ \t]*\\([^,]+\\)" expn-str)
509 (setq expn (elmo-match-string 1 expn-str))
510 (setq expn-str (wl-string-delete-match expn-str 0))
511 (if (string-match "^[ \t,]+" expn-str)
512 (setq expn-str (wl-string-delete-match expn-str 0)))
513 (if (string-match "[ \t,]+$" expn)
514 (setq expn (wl-string-delete-match expn 0)))
515 (setq new-expn (cdr (assoc expn alist)))
518 (setq new-expn-str (concat new-expn-str (and new-expn-str ", ")
519 (or new-expn expn))))
521 (setcdr (nth n alist) new-expn-str))
524 (wl-address-expand-aliases alist (1+ nest-count))))))
526 (defun wl-address-make-alist-from-alias-file (file)
528 (let ((case-fold-search t)
530 (insert-file-contents file)
531 (while (re-search-forward ",$" nil t)
534 (delete-backward-char 1))
535 (goto-char (point-min))
536 (while (re-search-forward "^\\([^#;\n][^:]+\\):[ \t]*\\(.*\\)$" nil t)
537 (setq alias (wl-match-buffer 1)
538 expn (wl-match-buffer 2))
539 (setq alist (cons (cons alias expn) alist)))
540 (wl-address-expand-aliases alist 0)
541 (nreverse alist) ; return value
544 (defun wl-address-make-address-list (path)
545 (when (and path (file-readable-p path))
548 (coding-system-for-read wl-cs-autoconv))
549 (insert-file-contents path)
550 (goto-char (point-min))
553 ^\\([^#\n][^ \t\n]+\\)[ \t]+\\(\".*\"\\)[ \t]+\\(\".*\"\\)[ \t]*.*$")
556 (list (wl-match-buffer 1)
557 (read (wl-match-buffer 2))
558 (read (wl-match-buffer 3)))
564 (defsubst wl-address-header-extract-address (str)
565 "Extracts a real e-mail address from STR and return it.
566 e.g. \"Mine Sakurai <m-sakura@ccs.mt.nec.co.jp>\"
567 -> \"m-sakura@ccs.mt.nec.co.jp\".
568 e.g. \"m-sakura@ccs.mt.nec.co.jp (Mine Sakurai)\"
569 -> \"m-sakura@ccs.mt.nec.co.jp\"."
570 (cond ((string-match ".*<\\([^>]*\\)>" str) ; .* to extract last <>
571 (wl-match-string 1 str))
572 ((string-match "\\([^ \t\n]*@[^ \t\n]*\\)" str)
573 (wl-match-string 1 str))
576 (defsubst wl-address-header-extract-realname (str)
577 "Extracts a real name from STR and return it.
578 e.g. \"Mr. bar <hoge@foo.com>\"
580 (cond ((string-match "\\(.*[^ \t]\\)[ \t]*<[^>]*>" str)
581 (wl-match-string 1 str))
585 (defun wl-address-get-petname-1 (string)
586 (let ((address (downcase (wl-address-header-extract-address string))))
587 (elmo-get-hash-val address wl-address-petname-hash)))
589 (defsubst wl-address-get-petname (string)
590 (or (wl-address-get-petname-1 string)
593 (defun wl-address-user-mail-address-p (address)
594 "Judge whether ADDRESS is user's or not."
595 (if wl-user-mail-address-regexp
596 (string-match wl-user-mail-address-regexp
597 (wl-address-header-extract-address address))
598 (member (downcase (wl-address-header-extract-address address))
599 (or (mapcar 'downcase wl-user-mail-address-list)
601 (wl-address-header-extract-address
604 (defun wl-address-delete-user-mail-addresses (address-list)
605 "Delete user mail addresses from list by side effect.
606 Deletion is done by using `elmo-list-delete'."
607 (if wl-user-mail-address-regexp
608 (elmo-list-delete (list wl-user-mail-address-regexp) address-list
611 (lambda (item) (string-match elem item))
613 (let ((myself (or wl-user-mail-address-list
614 (list (wl-address-header-extract-address wl-from)))))
615 (elmo-list-delete myself address-list
618 (lambda (item) (string= (downcase elem)
622 (defmacro wl-address-concat-token (string token)
624 ((eq 'quoted-string (car (, token)))
625 (concat (, string) "\"" (cdr (, token)) "\""))
626 ((eq 'comment (car (, token)))
627 (concat (, string) "(" (cdr (, token)) ")"))
629 (concat (, string) (cdr (, token)))))))
631 (defun wl-address-string-without-group-list-contents (sequence)
632 "Return address string from lexical analyzed list SEQUENCE.
633 Group list contents is not included."
634 (let (address-string route-addr-end token seq group-end)
636 (setq token (car sequence))
638 ;; group = phrase ":" [#mailbox] ";"
639 ((and (eq 'specials (car token))
640 (string= (cdr token) ":"))
641 (setq address-string (concat address-string (cdr token))) ; ':'
642 (setq seq (cdr sequence))
643 (setq token (car seq))
645 (while (not group-end)
646 (setq token (car seq))
648 (setq group-end (and (eq 'specials (car token))
649 (string= (cdr token) ";"))))
650 (setq address-string (concat address-string (cdr token))) ; ';'
652 ;; route-addr = "<" [route] addr-spec ">"
653 ;; route = 1#("@" domain) ":" ; path-relative
654 ((and (eq 'specials (car token))
655 (string= (cdr token) "<"))
656 (setq seq (std11-parse-route-addr sequence))
657 (setq route-addr-end (car (cdr seq)))
658 (while (not (eq (car sequence) route-addr-end))
659 (setq address-string (wl-address-concat-token address-string
661 (setq sequence (cdr sequence))))
663 (setq address-string (wl-address-concat-token address-string token))
664 (setq sequence (cdr sequence)))))
667 (defun wl-address-delete (the-email)
668 "Delete address entry in the `wl-address-file'."
669 (let ((output-coding-system
670 (mime-charset-to-coding-system wl-mime-charset)))
672 (message "Deleting Address...")
673 (insert-file-contents wl-address-file)
674 (delete-matching-lines (concat "^[ \t]*" the-email "[ \t]+\".*\"[ \t]+\".*\"$"))
675 (write-region (point-min) (point-max)
676 wl-address-file nil 'no-msg)
678 (dolist (entry (elmo-string-assoc-all the-email wl-address-list))
679 (setq wl-address-list (delete entry wl-address-list)))
680 (elmo-set-hash-val the-email nil wl-address-petname-hash)
681 (message "Deleting Address...done"))))
683 (defun wl-address-add-or-change (address
684 &optional default-realname
686 "Add address entry to `wl-address-file', if not registerd.
687 If already registerd, change it."
688 (let ((entry (assoc address wl-address-list))
689 the-realname the-petname new-addr addr-changed)
691 (read-from-minibuffer "Real Name: " (or default-realname
693 (setq the-petname (read-from-minibuffer "Petname: "
697 (setq new-addr (read-from-minibuffer "E-Mail: " address))
699 ((or (not (stringp new-addr))
700 (string-match "^[ \t]*$" new-addr))
701 (error "empty address"))
702 ((and (not (string= address new-addr))
703 (assoc new-addr wl-address-list))
704 (error "'%s' already exists" new-addr))
708 ;; writing to ~/.address
709 (let ((output-coding-system
710 (mime-charset-to-coding-system wl-mime-charset)))
712 (if (file-exists-p wl-address-file)
713 (insert-file-contents wl-address-file))
717 (goto-char (point-max))
718 (if (and (> (buffer-size) 0)
719 (not (eq (char-after (1- (point-max))) ?\n)))
722 (while (re-search-forward (concat "^[ \t]*" address) nil t)
723 (delete-region (save-excursion (beginning-of-line)
725 (save-excursion (end-of-line)
727 (insert (format "%s\t%s\t%s\n"
728 (or new-addr address)
729 (prin1-to-string the-petname)
730 (prin1-to-string the-realname)))
731 (write-region (point-min) (point-max)
732 wl-address-file nil 'no-msg)
734 (list (or new-addr address) the-petname the-realname)))))
736 ;; Read addresses from minibuffer with completion.
737 (defvar wl-address-minibuffer-history nil)
738 (defvar wl-address-minibuffer-local-map nil
739 "Keymap to use when reading address from the minibuffer.")
741 (unless wl-address-minibuffer-local-map
742 (let ((map (make-sparse-keymap)))
743 (set-keymap-parent map minibuffer-local-map)
744 (define-key map "\C-i"
747 (wl-complete-field-body wl-address-completion-list
748 ?@ nil wl-use-ldap)))
749 (setq wl-address-minibuffer-local-map map)))
751 (defun wl-address-read-from-minibuffer (prompt &optional
754 (read-from-minibuffer prompt
756 wl-address-minibuffer-local-map
758 'wl-address-minibuffer-history
762 (product-provide (provide 'wl-address) (require 'wl-version))
764 ;;; wl-address.el ends here