(require 'wl-util)
(require 'wl-vars)
(require 'std11)
+(eval-when-compile (require 'cl))
-(defvar wl-address-complete-header-list
+(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.
;; make mail addrses list
(while mails
(if (null (assoc (car mails) cl)); Not already in cl.
- ;; (string-match regexp (car mails))
+;;; (string-match regexp (car mails))
;; add mail address itself to completion list
(setq result (cons (cons (car mails)
(concat cn " <" (car mails) ">"))
(if (and (get-buffer-window wl-completion-buf-name)
(equal wl-complete-candidates all))
(let ((win (get-buffer-window wl-completion-buf-name)))
- (save-excursion
- (set-buffer wl-completion-buf-name)
+ (with-current-buffer wl-completion-buf-name
(if (pos-visible-in-window-p (point-max) win)
(set-window-start win 1)
(scroll-other-window))))
((and epand-char
(> len 0)
(or (char-equal (aref pattern (1- len)) epand-char)
- (char-equal (aref pattern (1- len)) ?\ ))
+ (char-equal (aref pattern (1- len)) (string-to-char " ")))
(assoc (substring pattern 0 (1- len)) cl))
(wl-complete-insert
start end
(wl-address-expand-aliases alist (1+ nest-count))))))
(defun wl-address-make-alist-from-alias-file (file)
- (elmo-set-work-buf
+ (with-temp-buffer
(let ((case-fold-search t)
alias expn alist)
(insert-file-contents file)
(while (re-search-forward ",$" nil t)
(end-of-line)
(forward-char 1)
- (delete-backward-char 1))
+ (delete-char -1))
(goto-char (point-min))
(while (re-search-forward "^\\([^#;\n][^:]+\\):[ \t]*\\(.*\\)$" nil t)
(setq alias (wl-match-buffer 1)
)))
(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
- (cons
- (list (wl-match-buffer 1)
- (read (wl-match-buffer 2))
- (read (wl-match-buffer 3)))
- ret)))
- (forward-line))
- (nreverse ret)))))
+ (when (and path (file-readable-p path))
+ (with-temp-buffer
+ (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)))))
(defsubst wl-address-header-extract-address (str)
"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\"."
+e.g. \"Mine Sakurai <m-sakura@example.org>\"
+ -> \"m-sakura@example.org\".
+e.g. \"m-sakura@example.org (Mine Sakurai)\"
+ -> \"m-sakura@example.org\"."
(cond ((string-match ".*<\\([^>]*\\)>" str) ; .* to extract last <>
(wl-match-string 1 str))
((string-match "\\([^ \t\n]*@[^ \t\n]*\\)" str)
(defsubst wl-address-header-extract-realname (str)
"Extracts a real name from STR and return it.
-e.g. \"Mr. bar <hoge@foo.com>\"
+e.g. \"Mr. bar <hoge@example.com>\"
-> \"Mr. bar\"."
(cond ((string-match "\\(.*[^ \t]\\)[ \t]*<[^>]*>" str)
(wl-match-string 1 str))
(defun wl-address-user-mail-address-p (address)
"Judge whether ADDRESS is user's or not."
- (member (downcase (wl-address-header-extract-address address))
- (or (mapcar 'downcase wl-user-mail-address-list)
- (list (downcase
- (wl-address-header-extract-address
- wl-from))))))
+ (if wl-user-mail-address-regexp
+ (string-match wl-user-mail-address-regexp
+ (wl-address-header-extract-address address))
+ (member (downcase (wl-address-header-extract-address address))
+ (or (mapcar 'downcase wl-user-mail-address-list)
+ (list (downcase
+ (wl-address-header-extract-address
+ wl-from)))))))
(defun wl-address-delete-user-mail-addresses (address-list)
"Delete user mail addresses from list by side effect.
Deletion is done by using `elmo-list-delete'."
- (let ((myself (or wl-user-mail-address-list
- (list (wl-address-header-extract-address wl-from)))))
- (elmo-list-delete myself address-list
- (lambda (elem list)
- (elmo-delete-if
- (lambda (item) (string= (downcase elem)
- (downcase item)))
- list)))))
+ (if wl-user-mail-address-regexp
+ (elmo-list-delete (list wl-user-mail-address-regexp) address-list
+ (lambda (elem list)
+ (elmo-delete-if
+ (lambda (item) (string-match elem item))
+ list)))
+ (let ((myself (or wl-user-mail-address-list
+ (list (wl-address-header-extract-address wl-from)))))
+ (elmo-list-delete myself address-list
+ (lambda (elem list)
+ (elmo-delete-if
+ (lambda (item) (string= (downcase elem)
+ (downcase item)))
+ list))))))
(defmacro wl-address-concat-token (string token)
- (` (cond
- ((eq 'quoted-string (car (, token)))
- (concat (, string) "\"" (cdr (, token)) "\""))
- ((eq 'comment (car (, token)))
- (concat (, string) "(" (cdr (, token)) ")"))
- (t
- (concat (, string) (cdr (, token)))))))
+ `(cond
+ ((eq 'quoted-string (car ,token))
+ (concat ,string "\"" (cdr ,token) "\""))
+ ((eq 'comment (car ,token))
+ (concat ,string "(" (cdr ,token) ")"))
+ (t
+ (concat ,string (cdr ,token)))))
(defun wl-address-string-without-group-list-contents (sequence)
"Return address string from lexical analyzed list SEQUENCE.
(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 (point-at-bol) (1+ (point-at-eol)))))
(insert (format "%s\t%s\t%s\n"
(or new-addr address)
(prin1-to-string the-petname)
(wl-address-init)
(list (or new-addr address) the-petname the-realname)))))
+;; Read addresses from minibuffer with completion.
+(defvar wl-address-minibuffer-history nil)
+(defvar wl-address-minibuffer-local-map nil
+ "Keymap to use when reading address from the minibuffer.")
+
+(unless wl-address-minibuffer-local-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\C-i"
+ (lambda ()
+ (interactive)
+ (wl-complete-field-body wl-address-completion-list
+ ?@ nil wl-use-ldap)))
+ (setq wl-address-minibuffer-local-map map)))
+
+(defun wl-address-read-from-minibuffer (prompt &optional
+ initial-contents
+ default-value)
+ (read-from-minibuffer prompt
+ initial-contents
+ wl-address-minibuffer-local-map
+ nil
+ 'wl-address-minibuffer-history
+ default-value))
+
(require 'product)
(product-provide (provide 'wl-address) (require 'wl-version))