X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-action.el;h=1294022db6a8afdcc59f79c8ad1706648f7d183f;hb=4fe7e666d0bfaa50356a7e51d101658c0955d763;hp=6274a5ebd0bc048a5962b8ea4646feec0ab5bef5;hpb=b9724bfc05343c10aab7ead4372340fcbaade981;p=elisp%2Fwanderlust.git diff --git a/wl/wl-action.el b/wl/wl-action.el index 6274a5e..1294022 100644 --- a/wl/wl-action.el +++ b/wl/wl-action.el @@ -51,9 +51,13 @@ (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)