(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.
(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))))))
(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)
(delq elem wl-summary-buffer-temp-mark-list))))
(defun wl-summary-registered-temp-mark (number)
- (assq number wl-summary-buffer-temp-mark-list))
+ (and wl-summary-buffer-temp-mark-list
+ (assq number wl-summary-buffer-temp-mark-list)))
(defun wl-summary-collect-temp-mark (mark &optional begin end)
(if (or begin end)
(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)
(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
(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)
(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)
- (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))))
+ (when (null data)
+ (error "Destination folder is empty"))
+ (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."
(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
(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.
;; 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))
"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.
(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)
(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)))
(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))
(goto-char (point-min))
;; for thread...
(if (eq wl-summary-buffer-view 'thread)
- (let (number entity mark-info)
+ (let (number entity)
(while (not (eobp))
(setq numbers (cons (wl-summary-message-number) numbers)
entity (wl-thread-get-entity number))
(dolist (msg (wl-thread-get-children-msgs number))
(setq numbers (cons msg numbers))))
(forward-line 1)))
- (let (number mark-info)
+ (let (number)
(while (not (eobp))
(setq numbers (cons (wl-summary-message-number) numbers))
(forward-line 1))))
- numbers))))
+ (nreverse (delq nil numbers))))))
(defun wl-summary-exec (&optional numbers)
(interactive)
(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)
(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")
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)
(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))
(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)
"Return t if temporal MARK should be reserved."
(member mark wl-summary-reserve-mark-list))
+;; Refile prev destination
(defun wl-summary-refile-prev-destination ()
"Refile message to previously refiled destination."
(interactive)
(funcall (symbol-function 'wl-summary-refile)
+ (wl-summary-message-number)
wl-summary-buffer-prev-refile-destination)
- (if (eq wl-summary-move-direction-downward nil)
+ (if (and (interactive-p)
+ (eq wl-summary-move-direction-downward nil))
(wl-summary-prev)
(wl-summary-next)))
+(defun wl-summary-refile-prev-destination-region (beg end)
+ "Refile messages in the region to previously refiled destination."
+ (interactive "r")
+ (wl-summary-mark-region-subr 'wl-summary-refile
+ beg end
+ wl-summary-buffer-prev-refile-destination))
+
+(defun wl-thread-refile-prev-destination (arg)
+ "Refile messages in the thread to previously refiled destination."
+ (interactive "P")
+ (wl-thread-call-region-func
+ 'wl-summary-refile-prev-destination-region
+ arg))
+
+(defun wl-summary-target-mark-refile-prev-destination ()
+ "Refile messages with target mark to previously refiled destination."
+ (interactive)
+ (let ((elem wl-summary-mark-action-list)
+ action)
+ (while elem
+ (when (eq (wl-summary-action-symbol (car elem)) 'refile)
+ (setq action (car elem))
+ (setq elem nil))
+ (setq elem (cdr elem)))
+ (wl-summary-target-mark-set-action
+ (list
+ (car action)
+ 'refile-prev-destination
+ (lambda (&rest args) wl-summary-buffer-prev-refile-destination)
+ (nth 2 action)
+ (nth 3 action)
+ (nth 4 action)
+ (nth 6 action)))))
+
(defsubst wl-summary-no-auto-refile-message-p (number)
(member (wl-summary-message-mark wl-summary-buffer-elmo-folder number)
wl-summary-auto-refile-skip-marks))
+(defvar wl-auto-refile-guess-functions
+ '(wl-refile-guess-by-rule)
+ "*List of functions which is used for guessing refile destination folder.")
+
(defun wl-summary-auto-refile (&optional open-all)
"Set refile mark automatically according to 'wl-refile-guess-by-rule'."
(interactive "P")
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
(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-by-rule
+ (wl-refile-guess
(elmo-message-entity wl-summary-buffer-elmo-folder
- number))))
+ number)
+ wl-auto-refile-guess-functions)))
(not (equal dst spec))
(let ((pair (assoc dst checked-dsts))
ret)
(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")
(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
- nil '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))
- (let (deleted)
- (dolist (mark-info wl-summary-buffer-temp-mark-list)
- (when (string= (nth 1 mark-info) mark)
- (setq deleted (cons mark-info deleted))))
- (dolist (delete deleted)
- (setq wl-summary-buffer-temp-mark-list
- (delq delete wl-summary-buffer-temp-mark-list)))))
+ (if (string= mark "*")
+ (setq wl-summary-buffer-target-mark-list nil)
+ (let (deleted)
+ (dolist (mark-info wl-summary-buffer-temp-mark-list)
+ (when (string= (nth 1 mark-info) mark)
+ (setq deleted (cons mark-info deleted))))
+ (dolist (delete deleted)
+ (setq wl-summary-buffer-temp-mark-list
+ (delq delete wl-summary-buffer-temp-mark-list))))))
(defun wl-summary-unmark-all ()
"Unmark all according to what you input."
projects / elisp / wanderlust.git / blobdiff