* wl-util.el (wl-delete-alist): Doc fix.

(wl-delete-associations): New function.
(wl-inverse-alist): New function.
* wl-summary.el (wl-summary-exec-subr): Rename parameters.
Split temporary variables. Use `wl-delete-associations'
and `wl-inverse-alist'.
(wl-summary-delete-copy-marks-on-buffer): Rename the parameter.

diff --git a/wl/wl-summary.el b/wl/wl-summary.el
index 0f57655..9d6e63a 100644 (file)
--- a/wl/wl-summary.el
+++ b/wl/wl-summary.el
@@ -1549,11 +1549,11 @@ If optional argument is non-nil, checking is omitted."
        (delete-region (match-beginning 1) (match-end 1))
        (insert " ")))))
 
-(defun wl-summary-delete-copy-marks-on-buffer (cpys)
+(defun wl-summary-delete-copy-marks-on-buffer (copies)
   (mapcar (function
           (lambda (x)
             (wl-summary-unmark x)))
-         cpys))
+         copies))
 
 (defun wl-summary-delete-all-refile-marks ()
   (mapcar (function
@@ -3267,21 +3267,26 @@ If optional argument NUMBER is specified, mark message specified by NUMBER."
                          (wl-summary-mark-collect "D" beg end)
                          (wl-summary-mark-collect "O" beg end))))
   
-(defun wl-summary-exec-subr (msgs dels cpys)
-  (save-excursion
-    (let* ((del-fld (wl-summary-get-delete-folder 
-                    wl-summary-buffer-folder-name))
-          (start (point))
-          dst tmp msg msgs2 cpys2
-          msg-dst dst-msgs len 
-          refile-failures 
-          copy-failures
-          succeeds result executed)
-      (if (not (or msgs dels cpys))
-         (message "No marks")
+(defun wl-summary-exec-subr (moves dels copies)
+  (if (not (or moves dels copies))
+      (message "No marks")
+    (save-excursion
+      (let ((del-fld (wl-summary-get-delete-folder 
+                     wl-summary-buffer-folder-name))
+           (start (point))
+           (unread-marks (list wl-summary-unread-cached-mark
+                               wl-summary-unread-uncached-mark
+                               wl-summary-new-mark))
+           (refiles (append moves dels))
+           (refile-executed 0)
+           (refile-failures 0)
+           (copy-executed 0)
+           (copy-failures 0)
+           (copy-len (length copies))
+           refile-len
+           dst-msgs                    ; loop counter
+           result)
        (message "Executing ...")
-       (setq msgs (append msgs dels))
-       (setq msgs2 msgs)
        (while dels
          (when (not (assq (car dels) wl-summary-buffer-refile-list))
            (wl-append wl-summary-buffer-refile-list
@@ -3289,21 +3294,12 @@ If optional argument NUMBER is specified, mark message specified by NUMBER."
            (setq wl-summary-buffer-delete-list
                  (delete (car dels) wl-summary-buffer-delete-list)))
          (setq dels (cdr dels)))
-       (setq len (length msgs2))
        ;; begin refile...
-       (while msgs
-         (setq msg (car msgs))
-         (setq msgs (cdr msgs))
-         (setq msg-dst (assq msg wl-summary-buffer-refile-list))
-         (setq dst (cdr msg-dst))
-         (if dst
-             (if (setq tmp (assoc dst dst-msgs))
-                 (setq dst-msgs (cons (append tmp (list msg))
-                                        (delete tmp dst-msgs)))
-               (setq dst-msgs (cons (list dst msg) dst-msgs)))))
-       (setq refile-failures 0)
-       (goto-char start) ; avoid moving cursor to the bottom line.
-       (setq executed 0)
+       (setq refile-len (length refiles))
+       (setq dst-msgs
+             (wl-inverse-alist refiles wl-summary-buffer-refile-list))
+       (goto-char start)               ; avoid moving cursor to
+                                       ; the bottom line.
        (while dst-msgs
          ;;(elmo-msgdb-add-msgs-to-seen-list 
          ;; (car (car dst-msgs)) ;dst-folder      
@@ -3317,83 +3313,59 @@ If optional argument NUMBER is specified, mark message specified by NUMBER."
                                           (cdr (car dst-msgs))
                                           (car (car dst-msgs))
                                           wl-summary-buffer-msgdb 
-                                          len executed (cdr dst-msgs)
+                                          refile-len
+                                          refile-executed
+                                          (not (null (cdr dst-msgs)))
                                           nil ; no-delete
                                           nil ; same-number
-                                          (list wl-summary-unread-cached-mark
-                                                wl-summary-unread-uncached-mark
-                                                wl-summary-new-mark)))
+                                          unread-marks))
            (error nil))
-         (if result ; succeeded.
+         (if result                    ; succeeded.
              (progn
                ;; update buffer.
-               (wl-summary-delete-messages-on-buffer 
-                (cdr (car dst-msgs)))
+               (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
                ;; update refile-alist.
-               (mapcar 
-                (function 
-                 (lambda (x)
-                   (setq wl-summary-buffer-refile-list
-                         (delq (assq x wl-summary-buffer-refile-list)
-                               wl-summary-buffer-refile-list))))
-                (cdr (car dst-msgs))))
+               (setq wl-summary-buffer-refile-list
+                     (wl-delete-associations (cdr (car dst-msgs))
+                                            wl-summary-buffer-refile-list)))
            (setq refile-failures 
                  (+ refile-failures (length (cdr (car dst-msgs))))))
-         (setq executed (+ executed (length (cdr (car dst-msgs)))))
+         (setq refile-executed (+ refile-executed (length (cdr (car dst-msgs)))))
          (setq dst-msgs (cdr dst-msgs)))
        ;; end refile
        ;; begin cOpy...
-       (setq cpys2 cpys)
-       (setq len (length cpys2))
-       (while cpys
-         (setq msg (car cpys))
-         (setq cpys (cdr cpys))
-         (setq msg-dst (assq msg wl-summary-buffer-copy-list))
-         (setq dst (cdr msg-dst))
-         (if dst
-             (if (setq tmp (assoc dst dst-msgs))
-                 (setq dst-msgs (cons (append tmp (list msg))
-                                      (delete tmp dst-msgs)))
-               (setq dst-msgs (cons (list dst msg) dst-msgs)))))
-       (setq copy-failures 0)
-       (setq executed 0)
+       (setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list))
        (while dst-msgs
          ;;(elmo-msgdb-add-msgs-to-seen-list 
-         ;;(car (car dst-msgs)) ;dst-folder       
-         ;;(cdr (car dst-msgs)) ;msgs 
-         ;;wl-summary-buffer-msgdb 
-         ;;(concat wl-summary-important-mark
-         ;;wl-summary-read-uncached-mark))
+         ;; (car (car dst-msgs)) ;dst-folder      
+         ;; (cdr (car dst-msgs)) ;msgs 
+         ;; wl-summary-buffer-msgdb 
+         ;; (concat wl-summary-important-mark
+         ;;  wl-summary-read-uncached-mark))
          (setq result nil)
          (condition-case nil
              (setq result (elmo-move-msgs wl-summary-buffer-folder-name 
                                           (cdr (car dst-msgs))
                                           (car (car dst-msgs))
                                           wl-summary-buffer-msgdb 
-                                          len executed 
-                                          (cdr dst-msgs) 
+                                          copy-len
+                                          copy-executed 
+                                          (not (null (cdr dst-msgs)))
                                           t ; t is no-delete (copy)
                                           nil ; same number
-                                          (list 
-                                           wl-summary-unread-cached-mark
-                                           wl-summary-unread-uncached-mark
-                                           wl-summary-new-mark)))
+                                          unread-marks))
            (error nil))
-         (if result ; succeeded.
+         (if result                    ; succeeded.
              (progn
                ;; update buffer.
                (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
                ;; update copy-alist
-               (mapcar
-                (function
-                 (lambda (x)
-                   (setq wl-summary-buffer-copy-list
-                         (delq (assq x wl-summary-buffer-copy-list)
-                               wl-summary-buffer-copy-list))))
-                (cdr (car dst-msgs))))
+               (setq wl-summary-buffer-copy-list
+                     (wl-delete-associations (cdr (car dst-msgs))
+                                             wl-summary-buffer-copy-list)))
            (setq copy-failures
                  (+ copy-failures (length (cdr (car dst-msgs))))))
-         (setq executed (+ executed (length (cdr (car dst-msgs)))))
+         (setq copy-executed (+ copy-executed (length (cdr (car dst-msgs)))))
          (setq dst-msgs (cdr dst-msgs)))
        ;; end cOpy 
        (wl-summary-folder-info-update)

diff --git a/wl/wl-util.el b/wl/wl-util.el
index 135e9ee..3162092 100644 (file)
--- a/wl/wl-util.el
+++ b/wl/wl-util.el
@@ -553,12 +553,42 @@ or between BEG and END."
              (list (list item value))))))
 
 (defun wl-delete-alist (key alist)
-  "Delete all entries in ALIST that have a key eq to KEY."
+  "Delete by side effect any entries specified with KEY from ALIST.
+Return the modified ALIST.  Key comparison is done with `assq'.
+Write `(setq foo (wl-delete-alist key foo))' to be sure of changing
+the value of `foo'."
   (let (entry)
     (while (setq entry (assq key alist))
       (setq alist (delq entry alist)))
     alist))
 
+(defun wl-delete-associations (keys alist)
+  "Delete by side effect any entries specified with KEYS from ALIST.
+Return the modified ALIST.  KEYS must be a list of keys for ALIST.
+Deletion is done with `wl-delete-alist'.
+Write `(setq foo (wl-delete-associations keys foo))' to be sure of
+changing the value of `foo'."
+  (while keys
+    (setq alist (wl-delete-alist (car keys) alist))
+    (setq keys (cdr keys)))
+  alist)
+
+(defun wl-inverse-alist (keys alist)
+  "Inverse ALIST, copying.  Return an association list represents
+the inverse mapping of ALIST, from objects to KEYS.
+The objects mapped (cdrs of elements of the ALIST) are shared."
+  (let (x y tmp result)
+    (while keys
+      (setq x (car keys))
+      (setq y (cdr (assq x alist)))
+      (if y
+         (if (setq tmp (assoc y result))
+             (setq result (cons (append tmp (list x))
+                                (delete tmp result)))
+           (setq result (cons (list y x) result))))
+      (setq keys (cdr keys)))
+    result))
+
 (eval-when-compile 
   (require 'static))
 (static-unless (fboundp 'pp)