* wl-message.el (wl-message-buffer-cache-buffer-get)
[elisp/wanderlust.git] / wl / wl-address.el
index f204a44..d41537d 100644 (file)
@@ -37,7 +37,7 @@
 (require 'wl-vars)
 (require 'std11)
 
-(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.
@@ -454,7 +454,8 @@ Matched address lists are append to CL."
             (message "Sole completion"))
            ((and epand-char
                  (> len 0)
-                 (char-equal (aref pattern (1- len)) epand-char)
+                 (or (char-equal (aref pattern (1- len)) epand-char)
+                     (char-equal (aref pattern (1- len)) ?\ ))
                  (assoc (substring pattern 0 (1- len)) cl))
             (wl-complete-insert
              start end
@@ -523,7 +524,7 @@ Refresh `wl-address-list', `wl-address-completion-list', and
           (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)
@@ -541,39 +542,24 @@ Refresh `wl-address-list', `wl-address-completion-list', and
       )))
 
 (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)))))
-
-(defun wl-address-get-petname-1 (string)
-  (let ((address (downcase (wl-address-header-extract-address string))))
-    (elmo-get-hash-val address wl-address-petname-hash)))
-
-(defsubst wl-address-get-petname (string)
-  (or (wl-address-get-petname-1 string)
-      string))
+  (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-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))))))
 
 (defsubst wl-address-header-extract-address (str)
   "Extracts a real e-mail address from STR and return it.
@@ -595,14 +581,52 @@ e.g. \"Mr. bar <hoge@foo.com>\"
         (wl-match-string 1 str))
        (t "")))
 
+
+(defun wl-address-get-petname-1 (string)
+  (let ((address (downcase (wl-address-header-extract-address string))))
+    (elmo-get-hash-val address wl-address-petname-hash)))
+
+(defsubst wl-address-get-petname (string)
+  (or (wl-address-get-petname-1 string)
+      string))
+
+(defun wl-address-user-mail-address-p (address)
+  "Judge whether ADDRESS is user's or not."
+  (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'."
+  (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.
@@ -671,9 +695,16 @@ If already registerd, change it."
                                                the-realname)))
     (when change-address
       (setq new-addr (read-from-minibuffer "E-Mail: " address))
-      (if (and (not (string= address new-addr))
-              (assoc new-addr wl-address-list))
-         (error "'%s' already exists" new-addr)))
+      (cond
+       ((or (not (stringp new-addr))
+           (string-match "^[ \t]*$" new-addr))
+       (error "empty address"))
+       ((and (not (string= address new-addr))
+            (assoc new-addr wl-address-list))
+       (error "'%s' already exists" new-addr))
+       (t
+       ;; do nothing
+       )))
     ;; writing to ~/.address
     (let ((output-coding-system
           (mime-charset-to-coding-system wl-mime-charset)))
@@ -702,6 +733,31 @@ If already registerd, change it."
        (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))