X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-addrmgr.el;h=72e6c96d06b138db1433b0eee03adcd228c7a161;hb=3292cda093d45703dd7adcbf612000796397855d;hp=dd5ba00d49ecfc9cab16057d199bfa9e88558e6a;hpb=50e87247bc89cd4eead8633be07a758798831042;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-addrmgr.el b/wl/wl-addrmgr.el
index dd5ba00..72e6c96 100644
--- a/wl/wl-addrmgr.el
+++ b/wl/wl-addrmgr.el
@@ -1,4 +1,4 @@
-;;; wl-addrmgr.el -- Address manager for Wanderlust.
+;;; wl-addrmgr.el --- Address manager for Wanderlust.
 
 ;; Copyright (C) 2001 Kitamoto Tsuyoshi <tsuyoshi.kitamoto@city.sapporo.jp>
 ;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
@@ -26,7 +26,7 @@
 ;;
 
 ;;; Commentary:
-;;   Edit To:, Cc:, Bcc: fields interactively from E-Mail address list 
+;;   Edit To:, Cc:, Bcc: fields interactively from E-Mail address list
 ;;   on ~/.address file.
 
 ;;; Code:
@@ -34,6 +34,7 @@
 
 (require 'wl-address)
 (require 'wl-draft)
+(eval-when-compile (require 'cl))
 
 ;; Variables
 (defgroup wl-addrmgr nil
@@ -87,20 +88,13 @@
   :group 'wl-addrmgr)
 
 (defcustom wl-addrmgr-default-method 'local
-  "Default access method for address entries.
-Defined by `wl-addrmgr-method-alist'."
+  "Default access method for address entries."
   :type 'symbol
   :group 'wl-addrmgr)
 
 (defvar wl-addrmgr-buffer-name "Address")
 (defvar wl-addrmgr-mode-map nil)
-
-(defvar wl-addrmgr-method-alist
-  '((local . (wl-addrmgr-local-list   ; list address entries
-	      wl-addrmgr-local-add    ; add address entry
-	      wl-addrmgr-local-edit   ; edit address entry
-	      wl-addrmgr-local-delete ; delete address entry
-	      ))))
+(defvar wl-addrmgr-method-list '(local))
 
 ;; buffer local variable.
 (defvar wl-addrmgr-draft-buffer nil)
@@ -153,7 +147,7 @@ Defined by `wl-addrmgr-method-alist'."
   (define-key wl-addrmgr-mode-map "\C-c\C-k" 'wl-addrmgr-quit)
 
   (define-key wl-addrmgr-mode-map "C"    'wl-addrmgr-change-method)
-  
+
   (define-key wl-addrmgr-mode-map "Z"    'wl-addrmgr-reload)
   (define-key wl-addrmgr-mode-map "\C-c\C-l" 'wl-addrmgr-redraw))
 
@@ -161,7 +155,7 @@ Defined by `wl-addrmgr-method-alist'."
   "Major mode for Wanderlust address management.
 See info under Wanderlust for full documentation.
 
-\\{wl-addrmgr-mode}"
+\\{wl-addrmgr-mode-map}"
   (kill-all-local-variables)
   (setq mode-name "Address"
 	major-mode 'wl-addrmgr-mode)
@@ -174,10 +168,36 @@ See info under Wanderlust for full documentation.
   "Return address list."
   (mapcar
    (lambda (addr)
-     (cons (nth 1 (std11-extract-address-components addr))
-	   addr))
+     (nth 1 (std11-extract-address-components addr)))
    (wl-parse-addresses
-    (mapconcat 'identity (elmo-multiple-fields-body-list (list field)) ","))))
+    (mapconcat
+     'identity
+     (elmo-multiple-fields-body-list (list field) mail-header-separator)
+     ","))))
+
+(defun wl-addrmgr-pickup-entry-list (buffer)
+  "Return a list of address entiry from BUFFER."
+  (when buffer
+    (with-current-buffer buffer
+      (mapcar
+       (lambda (addr)
+	 (let ((structure (std11-extract-address-components addr)))
+	   (list (cadr structure)
+		 (or (car structure) "")
+		 (or (car structure) ""))))
+       (wl-parse-addresses
+	(mapconcat
+	 'identity
+	 (elmo-multiple-fields-body-list '("to" "cc" "bcc")
+					 mail-header-separator)
+	 ","))))))
+
+(defun wl-addrmgr-merge-entries (base-list append-list)
+  "Return a merged list of address entiry."
+  (dolist (entry append-list)
+    (unless (assoc (car entry) base-list)
+      (setq base-list (nconc base-list (list entry)))))
+  base-list)
 
 ;;;###autoload
 (defun wl-addrmgr ()
@@ -190,7 +210,7 @@ See info under Wanderlust for full documentation.
     (if (eq major-mode 'wl-draft-mode)
 	(if (get-buffer-window wl-addrmgr-buffer-name)
 	    nil
-	  (split-window (selected-window) 
+	  (split-window (selected-window)
 			(- (window-height (selected-window))
 			   wl-addrmgr-buffer-lines))
 	  (select-window (next-window))
@@ -201,7 +221,7 @@ See info under Wanderlust for full documentation.
       (switch-to-buffer (get-buffer-create wl-addrmgr-buffer-name)))
     (set-buffer wl-addrmgr-buffer-name)
     (wl-addrmgr-mode)
-    (unless wl-addrmgr-method 
+    (unless wl-addrmgr-method
       (setq wl-addrmgr-method wl-addrmgr-default-method
 	    wl-addrmgr-method-name (symbol-name wl-addrmgr-default-method)))
     (unless wl-addrmgr-sort-key
@@ -209,7 +229,9 @@ See info under Wanderlust for full documentation.
     (unless wl-addrmgr-sort-order
       (setq wl-addrmgr-sort-order wl-addrmgr-default-sort-order))
     (setq wl-addrmgr-draft-buffer buffer)
-    (setq wl-addrmgr-list (wl-addrmgr-list))
+    (setq wl-addrmgr-list
+	  (wl-addrmgr-merge-entries (wl-addrmgr-list)
+				    (wl-addrmgr-pickup-entry-list buffer)))
     (wl-addrmgr-draw already-list)
     (setq wl-addrmgr-unknown-list already-list)
     (wl-addrmgr-goto-top)))
@@ -218,7 +240,9 @@ See info under Wanderlust for full documentation.
   (interactive)
   (goto-char (point-min))
   (forward-line 2)
-  (forward-char 4))
+  (condition-case nil
+      (forward-char 4)
+    (error)))
 
 (defun wl-addrmgr-goto-bottom ()
   (interactive)
@@ -275,7 +299,7 @@ See info under Wanderlust for full documentation.
     (put-text-property 0 (length addr) 'face
 		       wl-addrmgr-address-face
 		       addr)
-    (insert 
+    (insert
      (wl-set-string-width
       (- wl-addrmgr-line-width 4)
       (concat real " " pet " " addr)))
@@ -301,7 +325,7 @@ Return nil if no ADDRESS exists."
 	  list field addrs beg real pet addr)
       (erase-buffer)
       (goto-char (point-min))
-      (insert 
+      (insert
        "Mark "
        (wl-set-string-width wl-addrmgr-realname-width
 			    "Realname")
@@ -314,6 +338,7 @@ Return nil if no ADDRESS exists."
 	      " "
 	      (make-string wl-addrmgr-petname-width ?-)
 	      " ---------------")
+      (unless wl-addrmgr-list (insert "\n"))
       (dolist (entry (wl-addrmgr-sort-list wl-addrmgr-sort-key
 					   (copy-sequence wl-addrmgr-list)
 					   wl-addrmgr-sort-order))
@@ -326,12 +351,12 @@ Return nil if no ADDRESS exists."
 	      addrs (cdr list))
 	(while addrs
 	  (goto-char (point-min))
-	  (when (wl-addrmgr-search-forward-address (car (car addrs)))
+	  (when (wl-addrmgr-search-forward-address (car addrs))
 	    (wl-addrmgr-mark-write field)
 	    (setcdr list (delq (car addrs) (cdr list))))
 	  (setq addrs (cdr addrs)))
 	(setq already-list (cdr already-list))))))
-  
+
 (defun wl-addrmgr-next ()
   "Move cursor next line."
   (interactive)
@@ -367,13 +392,16 @@ Return nil if no ADDRESS exists."
       (forward-char 4)))))
 
 (defun wl-addrmgr-quit-yes ()
-  (if (and wl-addrmgr-draft-buffer
-	   (buffer-live-p wl-addrmgr-draft-buffer)
-	   (null (get-buffer-window wl-addrmgr-draft-buffer)))
-      (switch-to-buffer wl-addrmgr-draft-buffer)
-    (unless (one-window-p)
-      (delete-window)))
-  (kill-buffer wl-addrmgr-buffer-name))
+  (let ((draft-buffer wl-addrmgr-draft-buffer))
+    (if (and draft-buffer
+	     (buffer-live-p draft-buffer)
+	     (null (get-buffer-window draft-buffer 'visible)))
+	(switch-to-buffer draft-buffer)
+      (unless (one-window-p)
+	(delete-window)))
+    (kill-buffer wl-addrmgr-buffer-name)
+    (if (and draft-buffer (not (one-window-p)))
+	(switch-to-buffer-other-window draft-buffer))))
 
 (defun wl-addrmgr-quit ()
   "Exit from electric reference mode without inserting reference."
@@ -411,8 +439,7 @@ Return nil if no ADDRESS exists."
   (let ((entry (wl-addrmgr-address-entry))
 	buffer-read-only)
     (save-excursion
-      (beginning-of-line)
-      (delete-region (point) (progn (end-of-line)(point)))
+      (delete-region (point-at-bol) (point-at-eol))
       (wl-addrmgr-insert-line entry))
     (set-buffer-modified-p nil)
     (wl-addrmgr-next)))
@@ -420,8 +447,8 @@ Return nil if no ADDRESS exists."
 (defun wl-addrmgr-sort ()
   "Sort address entry."
   (interactive)
-  (setq wl-addrmgr-sort-key (intern 
-			     (completing-read 
+  (setq wl-addrmgr-sort-key (intern
+			     (completing-read
 			      (format "Sort By (%s): "
 				      (symbol-name wl-addrmgr-sort-key))
 			      '(("address")("realname")("petname")("none"))
@@ -429,8 +456,8 @@ Return nil if no ADDRESS exists."
 			      (symbol-name wl-addrmgr-sort-key))))
   (if (eq wl-addrmgr-sort-key 'none)
       (wl-addrmgr-reload)
-    (setq wl-addrmgr-sort-order (intern 
-				 (completing-read 
+    (setq wl-addrmgr-sort-order (intern
+				 (completing-read
 				  (format "Sort Order (%s): "
 					  (symbol-name wl-addrmgr-sort-order))
 				  '(("ascending") ("descending"))
@@ -447,14 +474,14 @@ Return nil if no ADDRESS exists."
 
 (defun wl-addrmgr-change-method ()
   (interactive)
-  (setq wl-addrmgr-method (intern 
+  (setq wl-addrmgr-method (intern
 			   (setq wl-addrmgr-method-name
-				 (completing-read 
+				 (completing-read
 				  (format "Method (%s): "
 					  (symbol-name wl-addrmgr-method))
-				  (mapcar (lambda (pair)
-					    (list (symbol-name (car pair))))
-					  wl-addrmgr-method-alist)
+				  (mapcar (lambda (method)
+					    (list (symbol-name method)))
+					  wl-addrmgr-method-list)
 				  nil t nil nil
 				  (symbol-name wl-addrmgr-method)))))
   (wl-addrmgr-redraw))
@@ -524,20 +551,15 @@ Return nil if no ADDRESS exists."
 ;;; Operations.
 
 (defun wl-addrmgr-address-entry ()
-  (save-excursion
-    (end-of-line)
-    (get-text-property (previous-single-property-change 
-			(point) 'wl-addrmgr-entry nil 
-			(progn
-			  (beginning-of-line)
-			  (point)))
-		       'wl-addrmgr-entry)))
+  (get-text-property (previous-single-property-change
+		      (point-at-eol) 'wl-addrmgr-entry nil
+		      (point-at-bol))
+		     'wl-addrmgr-entry))
 
 (defun wl-addrmgr-mark-write (&optional mark)
   "Set MARK to the current address entry."
-  (save-excursion 
-    (end-of-line)
-    (unless (< (count-lines (point-min) (point)) 3)
+  (save-excursion
+    (unless (< (count-lines (point-min) (point-at-eol)) 3)
       (let ((buffer-read-only nil) beg end)
 	(beginning-of-line)
 	(delete-char 4)
@@ -546,16 +568,12 @@ Return nil if no ADDRESS exists."
 		  (cc "Cc: ")
 		  (bcc "Bcc:")
 		  (t "    ")))
-	(insert (make-string (- 4 (current-column)) ? ))
-	(beginning-of-line)
-	(setq beg (point))
-	(setq end (progn (end-of-line)
-			 (point)))
+	(insert (make-string (- 4 (current-column)) (string-to-char " ")))
+	(setq beg (point-at-bol))
+	(setq end (point-at-eol))
 	(put-text-property beg end 'face nil)
 	(wl-highlight-message beg end nil))
-      (set-buffer-modified-p nil)
-      (beginning-of-line)
-      (forward-char 4))))
+      (set-buffer-modified-p nil))))
 
 (defun wl-addrmgr-apply ()
   (interactive)
@@ -582,35 +600,41 @@ Return nil if no ADDRESS exists."
 	(setq realname (nth 2 (wl-addrmgr-address-entry)))
 	(cond
 	 ((string= mark "To:")
-	  (setq to-list (cons (if full (concat
-					(wl-address-quote-specials realname)
-					" <" addr">")
-				addr)
-			      to-list)))
+	  (setq to-list (cons
+			 (if (and full
+				  (not (or (string= realname "")
+					   (string-match ".*:.*;$" addr))))
+			     (concat
+			      (wl-address-quote-specials realname)
+			      " <" addr">")
+			   addr)
+			 to-list)))
 	 ((string= mark "Cc:")
-	  (setq cc-list (cons (if full (concat
-					(wl-address-quote-specials realname)
-					" <" addr">")
-				addr)
-			      cc-list)))
+	  (setq cc-list (cons
+			 (if (and full
+				  (not (or (string= realname "")
+					   (string-match ".*:.*;$" addr))))
+			     (concat
+			      (wl-address-quote-specials realname)
+			      " <" addr">")
+			   addr)
+			 cc-list)))
 	 ((string= mark "Bcc:")
-	  (setq bcc-list (cons (if full (concat
-					 (wl-address-quote-specials realname)
-					 " <" addr">")
-				 addr)
-			       bcc-list)))))
+	  (setq bcc-list (cons
+			  (if (and full
+				   (not (or (string= realname "")
+					    (string-match ".*:.*;$" addr))))
+			      (concat
+			       (wl-address-quote-specials realname)
+			       " <" addr">")
+			    addr)
+			  bcc-list)))))
       (list to-list cc-list bcc-list))))
 
 (defun wl-addrmgr-apply-exec (rcpt)
-  (let ((to (nconc (nth 0 rcpt) (mapcar 
-				 'cdr
-				 (cdr (assq 'to wl-addrmgr-unknown-list)))))
-	(cc (nconc (nth 1 rcpt) (mapcar
-				 'cdr 
-				 (cdr (assq 'cc wl-addrmgr-unknown-list)))))
-	(bcc (nconc (nth 2 rcpt) (mapcar 
-				  'cdr 
-				  (cdr (assq 'bcc wl-addrmgr-unknown-list)))))
+  (let ((to (nconc (nth 0 rcpt) (cdr (assq 'to wl-addrmgr-unknown-list))))
+	(cc (nconc (nth 1 rcpt) (cdr (assq 'cc wl-addrmgr-unknown-list))))
+	(bcc (nconc (nth 2 rcpt) (cdr (assq 'bcc wl-addrmgr-unknown-list))))
 	from clist)
     (setq clist (list (cons "Bcc" (if bcc (mapconcat 'identity bcc ",\n\t")))
 		      (cons "Cc" (if cc (mapconcat 'identity cc ",\n\t")))
@@ -618,8 +642,8 @@ Return nil if no ADDRESS exists."
     (when (or (null wl-addrmgr-draft-buffer)
 	      (not (buffer-live-p wl-addrmgr-draft-buffer)))
       (setq wl-addrmgr-draft-buffer (save-window-excursion
-				   (wl-draft)
-				   (current-buffer))))
+				      (call-interactively 'wl-draft)
+				      (current-buffer))))
     (with-current-buffer wl-addrmgr-draft-buffer
       (setq from (std11-field-body "From"))
       (if from
@@ -638,12 +662,10 @@ Return nil if no ADDRESS exists."
 	(while (re-search-forward (concat "^" (regexp-quote field) ":") nil t)
 	  ;; delete field
 	  (progn
-	    (save-excursion
-	      (beginning-of-line)
-	      (setq beg (point)))
+	    (setq beg (point-at-bol))
 	    (re-search-forward "^[^ \t]" nil 'move)
-	    (beginning-of-line)
-	    (delete-region beg (point))))
+	    (delete-region beg (point-at-bol))
+	    (beginning-of-line)))
 	(when content
 	  ;; add field to top.
 	  (goto-char (point-min))
@@ -660,10 +682,7 @@ Return nil if no ADDRESS exists."
 	(put-text-property beg end 'face nil)
 	(wl-highlight-message beg end t))))
 
-;; beginning of the end
 (require 'product)
-(product-provide
-    (provide 'wl-addrmgr)
-  (require 'wl-version))
+(product-provide (provide 'wl-addrmgr) (require 'wl-version))
 
 ;;; wl-addrmgr.el ends here