Define unmark functions for temporary marks.
[elisp/wanderlust.git] / wl / wl-action.el
index 6274a5e..1294022 100644 (file)
   (concat (nth 6 action)
          "\nThis function is defined by `wl-summary-define-mark-action'."))
 
+(defsubst wl-summary-action-unmark-docstring (action)
+  (concat "Unmark `" (wl-summary-action-mark action) "' from the current line."
+         "\nIf NUMBER is non-nil, unmark the summary line specified by NUMBER."
+         "\nThis function is defined by `wl-summary-define-mark-action'."))
+
 ;; Set mark
 (defun wl-summary-set-mark (&optional set-mark number interactive data)
-  (interactive)
   "Set temporary mark SET-MARK on the message with NUMBER.
 NUMBER is the message number to set the mark on.
 INTERACTIVE is set as t if it have to run interactively.
@@ -101,11 +105,14 @@ Return number if put mark succeed"
                (wl-highlight-summary-current-line))
              (when data
                (wl-summary-print-argument number data)))
+           (when (and (eq wl-summary-buffer-view 'thread)
+                      interactive)
+             (wl-thread-open-children number))
            (set-buffer-modified-p nil)
            ;; Return value.
            number))
       ;; Move the cursor.
-      (if (or interactive (interactive-p))
+      (if interactive
          (if (eq wl-summary-move-direction-downward nil)
              (wl-summary-prev)
            (wl-summary-next))))))
@@ -124,6 +131,7 @@ Return number if put mark succeed"
 
 (defun wl-summary-target-mark-set-action (action)
   (unless (eq (wl-summary-action-symbol action) 'target-mark)
+    (unless wl-summary-buffer-target-mark-list (error "no target"))
     (save-excursion
       (goto-char (point-min))
       (let ((numlist wl-summary-buffer-number-list)
@@ -248,11 +256,11 @@ Return number if put mark succeed"
          (when (wl-summary-action-argument-function action)
            (wl-summary-remove-argument)))
        (set-buffer-modified-p nil))))
-  ;; Move the cursor.
-  ;;  (if (or interactive (interactive-p))
-  ;;      (if (eq wl-summary-move-direction-downward nil)
-  ;;     (wl-summary-prev)
-  ;;   (wl-summary-next))))
+;;; Move the cursor.
+;;;  (if (or interactive (interactive-p))
+;;;      (if (eq wl-summary-move-direction-downward nil)
+;;;      (wl-summary-prev)
+;;;    (wl-summary-next))))
   )
 
 (defun wl-summary-make-destination-numbers-list (mark-list)
@@ -275,35 +283,30 @@ Return number if put mark succeed"
       (let ((start (point))
            (refiles (mapcar 'car mark-list))
            (refile-failures 0)
-           refile-len
            dst-msgs                    ; loop counter
            result)
        ;; begin refile...
-       (setq refile-len (length refiles))
        (goto-char start)               ; avoid moving cursor to
                                        ; the bottom line.
-       (message message)
-       (when (> refile-len elmo-display-progress-threshold)
-         (elmo-progress-set 'elmo-folder-move-messages
-                            refile-len message))
-       (setq result nil)
-       (condition-case nil
-           (setq result (elmo-folder-move-messages
-                         wl-summary-buffer-elmo-folder
-                         refiles
-                         (if (eq folder-name 'null)
-                             'null
-                           (wl-folder-get-elmo-folder folder-name))))
-         (error nil))
-       (when result            ; succeeded.
-         ;; update buffer.
-         (wl-summary-delete-messages-on-buffer refiles)
-         ;; update wl-summary-buffer-temp-mark-list.
-         (dolist (mark-info mark-list)
-           (setq wl-summary-buffer-temp-mark-list
-                 (delq mark-info wl-summary-buffer-temp-mark-list))))
-       (elmo-progress-clear 'elmo-folder-move-messages)
-       (message (concat message "done"))
+       (elmo-with-progress-display
+           (elmo-folder-move-messages (length refiles))
+           message
+         (setq result nil)
+         (condition-case nil
+             (setq result (elmo-folder-move-messages
+                           wl-summary-buffer-elmo-folder
+                           refiles
+                           (if (eq folder-name 'null)
+                               'null
+                             (wl-folder-get-elmo-folder folder-name))))
+           (error nil))
+         (when result          ; succeeded.
+           ;; update buffer.
+           (wl-summary-delete-messages-on-buffer refiles)
+           ;; update wl-summary-buffer-temp-mark-list.
+           (dolist (mark-info mark-list)
+             (setq wl-summary-buffer-temp-mark-list
+                   (delq mark-info wl-summary-buffer-temp-mark-list)))))
        (wl-summary-set-message-modified)
        ;; Return the operation failed message numbers.
        (if result
@@ -361,6 +364,12 @@ Return number if put mark succeed"
             (interactive)
             (wl-summary-set-mark ,(wl-summary-action-mark action)
                                  number (interactive-p) data)))
+    (fset (intern (format "wl-summary-unmark-%s"
+                         (wl-summary-action-symbol action)))
+         `(lambda (&optional number)
+            ,(wl-summary-action-unmark-docstring action)
+            (interactive)
+            (wl-summary-unmark number ,(wl-summary-action-mark action))))
     (fset (intern (format "wl-summary-%s-region"
                          (wl-summary-action-symbol action)))
          `(lambda (beg end)
@@ -424,31 +433,20 @@ Return number if put mark succeed"
   (wl-summary-move-mark-list-messages mark-list
                                      (wl-summary-get-dispose-folder
                                       (wl-summary-buffer-folder-name))
-                                     "Disposing messages..."))
+                                     "Disposing messages"))
 
 ;; Delete action.
 (defun wl-summary-exec-action-delete (mark-list)
   (wl-summary-move-mark-list-messages mark-list
                                      'null
-                                     "Deleting messages..."))
+                                     "Deleting messages"))
 
 ;; Refile action
 (defun wl-summary-set-action-refile (number mark data)
   (when (null data)
     (error "Destination folder is empty"))
-  (let ((policy (wl-get-assoc-list-value wl-refile-policy-alist
-                                        (wl-summary-buffer-folder-name)))
-       (elem wl-summary-mark-action-list))
-    (if (eq policy 'copy)
-       (while elem
-         (when (eq (wl-summary-action-symbol (car elem)) 'copy)
-           (wl-summary-register-temp-mark number
-                                          (wl-summary-action-mark (car elem))
-                                          data)
-           (setq elem nil))
-         (setq elem (cdr elem)))
-      (wl-summary-register-temp-mark number mark data)
-      (setq wl-summary-buffer-prev-refile-destination data))))
+  (wl-summary-register-temp-mark number mark data)
+  (setq wl-summary-buffer-prev-refile-destination data))
 
 (defun wl-summary-get-refile-destination (action number)
   "Decide refile destination."
@@ -458,36 +456,28 @@ Return number if put mark succeed"
   (save-excursion
     (let ((start (point))
          (failures 0)
-         (refile-len (length mark-list))
-         dst-msgs ; loop counter
-         result)
+         dst-msgs)
       ;; begin refile...
-      (setq dst-msgs
-           (wl-summary-make-destination-numbers-list mark-list))
+      (setq dst-msgs (wl-summary-make-destination-numbers-list mark-list))
       (goto-char start)        ; avoid moving cursor to the bottom line.
-      (when (> refile-len elmo-display-progress-threshold)
-       (elmo-progress-set 'elmo-folder-move-messages
-                          refile-len "Refiling messages..."))
-      (while dst-msgs
-       (setq result nil)
-       (condition-case nil
-           (setq result (elmo-folder-move-messages
-                         wl-summary-buffer-elmo-folder
-                         (cdr (car dst-msgs))
-                         (wl-folder-get-elmo-folder (car (car dst-msgs)))))
-         (error nil))
-       (if result              ; succeeded.
-           (progn
-             ;; update buffer.
-             (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
-             (setq wl-summary-buffer-temp-mark-list
-                   (wl-delete-associations
-                    (cdr (car dst-msgs))
-                    wl-summary-buffer-temp-mark-list)))
-         (setq failures
-               (+ failures (length (cdr (car dst-msgs))))))
-       (setq dst-msgs (cdr dst-msgs)))
-      (elmo-progress-clear 'elmo-folder-move-messages)
+      (elmo-with-progress-display
+         (elmo-folder-move-messages (length mark-list))
+         "Refiling messages"
+       (dolist (pair dst-msgs)
+         (if (condition-case nil
+                 (elmo-folder-move-messages
+                  wl-summary-buffer-elmo-folder
+                  (cdr pair)
+                  (wl-folder-get-elmo-folder (car pair)))
+               (error nil))
+             (progn
+               ;; update buffer.
+               (wl-summary-delete-messages-on-buffer (cdr pair))
+               (setq wl-summary-buffer-temp-mark-list
+                     (wl-delete-associations
+                      (cdr pair)
+                      wl-summary-buffer-temp-mark-list)))
+           (setq failures (+ failures (length (cdr pair)))))))
       failures)))
 
 ;; Copy action
@@ -498,37 +488,30 @@ Return number if put mark succeed"
   (save-excursion
     (let ((start (point))
          (failures 0)
-         (refile-len (length mark-list))
-         dst-msgs ; loop counter
-         result)
+         dst-msgs)
       ;; begin refile...
       (setq dst-msgs
            (wl-summary-make-destination-numbers-list mark-list))
       (goto-char start)        ; avoid moving cursor to the bottom line.
-      (when (> refile-len elmo-display-progress-threshold)
-       (elmo-progress-set 'elmo-folder-move-messages
-                          refile-len "Copying messages..."))
-      (while dst-msgs
-       (setq result nil)
-       (condition-case nil
-           (setq result (elmo-folder-move-messages
-                         wl-summary-buffer-elmo-folder
-                         (cdr (car dst-msgs))
-                         (wl-folder-get-elmo-folder (car (car dst-msgs)))
-                         'no-delete))
-         (error nil))
-       (if result              ; succeeded.
-           (progn
-             ;; update buffer.
-             (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
-             (setq wl-summary-buffer-temp-mark-list
-                   (wl-delete-associations 
-                    (cdr (car dst-msgs))
-                    wl-summary-buffer-temp-mark-list)))
-         (setq failures
-               (+ failures (length (cdr (car dst-msgs))))))
-       (setq dst-msgs (cdr dst-msgs)))
-      (elmo-progress-clear 'elmo-folder-move-messages)
+      (elmo-with-progress-display
+         (elmo-folder-move-messages (length mark-list))
+         "Copying messages"
+       (dolist (pair dst-msgs)
+         (if (condition-case nil
+                 (elmo-folder-move-messages
+                  wl-summary-buffer-elmo-folder
+                  (cdr pair)
+                  (wl-folder-get-elmo-folder (car pair))
+                  'no-delete)
+               (error nil))
+             (progn
+               ;; update buffer.
+               (wl-summary-delete-copy-marks-on-buffer (cdr pair))
+               (setq wl-summary-buffer-temp-mark-list
+                     (wl-delete-associations
+                      (cdr pair)
+                      wl-summary-buffer-temp-mark-list)))
+           (setq failures (+ failures (length (cdr pair)))))))
       failures)))
 
 ;; Prefetch.
@@ -553,7 +536,7 @@ Return number if put mark succeed"
 ;; Resend.
 (defun wl-summary-get-resend-address (action number)
   "Decide resend address."
-  (completing-read "Resend message to: " 'wl-complete-address))
+  (wl-address-read-from-minibuffer "Resend message to: "))
 
 (defun wl-summary-exec-action-resend (mark-list)
   (let ((failure 0))
@@ -572,10 +555,9 @@ Return number if put mark succeed"
   "Resend the message with NUMBER to ADDRESS."
   (message "Resending message to %s..." address)
   (let ((folder wl-summary-buffer-elmo-folder))
-    (save-excursion
+    (with-current-buffer (get-buffer-create " *wl-draft-resend*")
       ;; We first set up a normal mail buffer.
-      (set-buffer (get-buffer-create " *wl-draft-resend*"))
-      (buffer-disable-undo (current-buffer))
+      (set-buffer-multibyte nil)
       (erase-buffer)
       (setq wl-sent-message-via nil)
       ;; Insert our usual headers.
@@ -593,11 +575,16 @@ Return number if put mark succeed"
       (let ((beg (point)))
        ;; Insert the message to be resent.
        (insert
-        (with-temp-buffer
-          (elmo-message-fetch folder number
-                              (elmo-make-fetch-strategy 'entire)
-                              nil (current-buffer) 'unread)
-          (buffer-string)))
+        ;; elmo-message-fetch is erase current buffer before fetch message
+        (elmo-message-fetch-string folder number
+                                   (if wl-summary-resend-use-cache
+                                       (elmo-make-fetch-strategy
+                                        'entire 'maybe nil
+                                        (elmo-file-cache-get-path
+                                         (elmo-message-field
+                                          folder number 'message-id)))
+                                     (elmo-make-fetch-strategy 'entire))
+                                   'unread))
        (goto-char (point-min))
        (search-forward "\n\n")
        (forward-char -1)
@@ -614,6 +601,7 @@ Return number if put mark succeed"
        (goto-char beg)
        (when (looking-at "From ")
          (replace-match "X-From-Line: ")))
+      (run-hooks 'wl-summary-resend-hook)
       ;; Send it.
       (wl-draft-dispatch-message)
       (kill-buffer (current-buffer)))
@@ -626,8 +614,8 @@ Return number if put mark succeed"
          (buffer-read-only nil)
          (buf (current-buffer))
          sol eol rs re)
+      (setq sol (point-at-bol))
       (beginning-of-line)
-      (setq sol (point))
       (search-forward "\r")
       (forward-char -1)
       (setq eol (point))
@@ -669,25 +657,26 @@ Return number if put mark succeed"
   (let ((failures 0)
        collected pair action modified)
     (dolist (action wl-summary-mark-action-list)
-      (setq collected (cons (cons 
+      (setq collected (cons (cons
                             (wl-summary-action-mark action)
                             nil) collected)))
     (dolist (mark-info wl-summary-buffer-temp-mark-list)
-      (if numbers
-         (when (memq (nth 0 mark-info) numbers)
-           (setq pair (assoc (nth 1 mark-info) collected)))
-       (setq pair (assoc (nth 1 mark-info) collected)))
-      (setq pair (assoc (nth 1 mark-info) collected))
-      (setcdr pair (cons mark-info (cdr pair))))
+      (setq pair
+           (when (or (null numbers)
+                     (memq (nth 0 mark-info) numbers))
+             (assoc (nth 1 mark-info) collected)))
+      (if pair
+         (setcdr pair (cons mark-info (cdr pair)))))
     ;; collected is a pair of
     ;; mark-string and a list of mark-info
     (dolist (pair collected)
-      (setq action (assoc (car pair) wl-summary-mark-action-list))
-      (when (and (cdr pair) (wl-summary-action-exec-function action))
-       (setq modified t)
-       (setq failures (+ failures (funcall
-                                   (wl-summary-action-exec-function action)
-                                   (cdr pair))))))
+      (when (cdr pair)
+       (setq action (assoc (car pair) wl-summary-mark-action-list))
+       (when (wl-summary-action-exec-function action)
+         (setq modified t)
+         (setq failures (+ failures (funcall
+                                     (wl-summary-action-exec-function action)
+                                     (cdr pair)))))))
     (when modified
       (wl-summary-set-message-modified))
     (run-hooks 'wl-summary-exec-hook)
@@ -700,7 +689,7 @@ Return number if put mark succeed"
       (setq wl-message-buffer nil))
     (set-buffer-modified-p nil)
     (when (> failures 0)
-      (format "%d execution(s) were failed" failures))))
+      (message "%d execution(s) were failed" failures))))
 
 (defun wl-summary-exec-region (beg end)
   (interactive "r")
@@ -732,16 +721,16 @@ Return number if put mark succeed"
                                      fld))))
     fld))
 
-(defun wl-summary-print-argument (msg-num folder)
+(defun wl-summary-print-argument (msg-num data)
   "Print action argument on line."
-  (when folder
+  (when data
     (wl-summary-remove-argument)
     (save-excursion
       (let ((inhibit-read-only t)
-           (folder (copy-sequence folder))
+           (data (copy-sequence data))
            (buffer-read-only nil)
            len rs re c)
-       (setq len (string-width folder))
+       (setq len (string-width data))
        (if (< len 1) ()
          ;;(end-of-line)
          (beginning-of-line)
@@ -754,7 +743,8 @@ Return number if put mark succeed"
                              (1- (window-width)))))
                (c (current-column))
                (padding 0))
-           (if (and width (> (+ c len) width))
+           (if (and width
+                    (> (+ c len) width))
                (progn
                  (move-to-column width)
                  (setq c (current-column))
@@ -762,18 +752,18 @@ Return number if put mark succeed"
                    (forward-char -1)
                    (setq c (current-column)))
                  (when (< (+ c len) width)
-                   (setq folder (concat " " folder)))
+                   (setq data (concat " " data)))
                  (setq rs (point))
                  (put-text-property rs re 'invisible t))
              (when (and width
                         (> (setq padding (- width len c)) 0))
-               (setq folder (concat (make-string padding ?\ )
-                                    folder)))
+               (setq data (concat (make-string padding (string-to-char " "))
+                                  data)))
              (setq rs (1- re))))
          (put-text-property rs re 'wl-summary-action-argument t)
          (goto-char re)
-         (wl-highlight-action-argument-string folder)
-         (insert folder)
+         (wl-highlight-action-argument-string data)
+         (insert data)
          (set-buffer-modified-p nil))))))
 
 (defsubst wl-summary-reserve-temp-mark-p (mark)
@@ -846,7 +836,7 @@ Return number if put mark succeed"
           checked-dsts
           (count 0)
           number dst thr-entity)
-      (goto-line 1)
+      (goto-char (point-min))
       (while (not (eobp))
        (setq number (wl-summary-message-number))
        (dolist (number (cons number
@@ -857,8 +847,9 @@ Return number if put mark succeed"
                                               (wl-thread-get-entity number))))
                                   (wl-thread-entity-get-descendant
                                    thr-entity))))
-         (when (and (not (wl-summary-no-auto-refile-message-p
-                          number))
+         (when (and (not (wl-summary-no-auto-refile-message-p number))
+                    (not (wl-summary-reserve-temp-mark-p
+                          (nth 1 (wl-summary-registered-temp-mark number))))
                     (setq dst
                           (wl-folder-get-realname
                            (wl-refile-guess
@@ -887,11 +878,14 @@ Return number if put mark succeed"
          (message "No message was marked.")
        (message "Marked %d message(s)." count)))))
 
-(defun wl-summary-unmark (&optional number)
-  "Unmark marks (temporary, refile, copy, delete)of current line.
-If optional argument NUMBER is specified, unmark message specified by NUMBER."
+(defun wl-summary-unmark (&optional number mark)
+  "Unmark temporary marks of the current line.
+If NUMBER is non-nil, remove the mark of the summary line specified by NUMBER.
+If MARK is non-nil, remove only the specified MARK from the summary line."
   (interactive)
-  (wl-summary-unset-mark number (interactive-p)))
+  (if (or (null mark)
+         (string= mark (wl-summary-temp-mark number)))
+      (wl-summary-unset-mark number (interactive-p))))
 
 (defun wl-summary-unmark-region (beg end)
   (interactive "r")
@@ -941,16 +935,12 @@ If optional argument NUMBER is specified, unmark message specified by NUMBER."
 
 (defun wl-summary-target-mark-all ()
   (interactive)
-  (wl-summary-target-mark-region (point-min) (point-max))
-  (setq wl-summary-buffer-target-mark-list
-       (elmo-folder-list-messages wl-summary-buffer-elmo-folder
-                                  t 'in-msgdb)))
+  (wl-summary-target-mark-region (point-min) (point-max)))
 
 (defun wl-summary-delete-all-mark (mark)
   (goto-char (point-min))
   (while (not (eobp))
-    (when (string= (wl-summary-temp-mark) mark)
-      (wl-summary-unmark))
+    (wl-summary-unmark nil mark)
     (forward-line 1))
   (if (string= mark "*")
       (setq wl-summary-buffer-target-mark-list nil)