From: teranisi Date: Tue, 15 Jul 2003 15:55:42 +0000 (+0000) Subject: * WL-ELS (WL-MODULES): Added wl-action. X-Git-Tag: elmo-mark-restart~50 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=bcec67f84fd9349fcb0d146f6cca5dd5ec201b29;p=elisp%2Fwanderlust.git * WL-ELS (WL-MODULES): Added wl-action. * wl.el (toplevel): Require wl-action. (wl-init): Call wl-summary-define-mark-action. * wl-vars.el (wl-summary-mark-action-list): Changed specification. * wl-summary.el (wl-summary-mode-menu-spec): Follow the rename of wl-summary-delete and wl-summary-erase. (wl-summary-mode-map): Ditto. * wl-vars.el (wl-dispose-folder-alist): Renamed from wl-delete-folder-alist. * wl-summary.el (wl-summary-prefetch-region-no-mark): Use wl-summary-prefetch-msg instead of wl-summary-prefetch. (toplevel): Moved mark & action related functions to the wl-action.el. * wl-highlight.el (wl-highlight-summary-line-string): Follow the change in wl-summary-mark-action-list. (wl-highlight-summary-current-line): Ditto. * wl-draft.el (wl-draft-normal-send-func): Fixed bug for removing empty lines. * wl-action.el: New file. --- diff --git a/ChangeLog b/ChangeLog index bc75d74..0528ad5 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2003-07-15 Yuuichi Teranishi + + * WL-ELS (WL-MODULES): Added wl-action. + 2003-06-05 TAKAHASHI Kaoru * WL-MK: Remove comment out code. Fix indent. diff --git a/WL-ELS b/WL-ELS index 6d68da0..99f3a1b 100644 --- a/WL-ELS +++ b/WL-ELS @@ -7,7 +7,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; generic modules (defconst WL-MODULES '( - wl wl-folder wl-summary wl-message + wl wl-folder wl-summary wl-action wl-message wl-vars wl-draft wl-util wl-version wl-address wl-addrmgr wl-highlight wl-demo wl-refile wl-thread wl-fldmgr wl-expire wl-template wl-score wl-acap wl-news diff --git a/wl/ChangeLog b/wl/ChangeLog index 26f0a26..ab3336a 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,30 @@ +2003-07-15 Yuuichi Teranishi + + * wl.el (toplevel): Require wl-action. + (wl-init): Call wl-summary-define-mark-action. + + * wl-vars.el (wl-summary-mark-action-list): Changed specification. + + * wl-summary.el (wl-summary-mode-menu-spec): Follow the rename of + wl-summary-delete and wl-summary-erase. + (wl-summary-mode-map): Ditto. + + * wl-vars.el (wl-dispose-folder-alist): Renamed from + wl-delete-folder-alist. + + * wl-summary.el (wl-summary-prefetch-region-no-mark): Use + wl-summary-prefetch-msg instead of wl-summary-prefetch. + (toplevel): Moved mark & action related functions to the wl-action.el. + + * wl-highlight.el (wl-highlight-summary-line-string): Follow the change + in wl-summary-mark-action-list. + (wl-highlight-summary-current-line): Ditto. + + * wl-draft.el (wl-draft-normal-send-func): Fixed bug for removing + empty lines. + + * wl-action.el: New file. + 2003-07-14 Yuuichi Teranishi * wl-summary.el (wl-summary-target-mark-replace): New function. diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 7d6f024..7bcd3a6 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -1150,15 +1150,23 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'." (defun wl-draft-normal-send-func (editing-buffer kill-when-done) "Send the message in the current buffer." (save-restriction - (std11-narrow-to-header mail-header-separator) - (wl-draft-insert-required-fields) - ;; Delete null fields. - (goto-char (point-min)) - (while (re-search-forward "^[^ \t\n:]+:[ \t]*\n" nil t) - (replace-match "")) + (narrow-to-region (goto-char (point-min)) + (if (re-search-forward + (concat + "^" (regexp-quote mail-header-separator) "$") + nil t) + (match-beginning 0) + (point-max))) ;; ignore any blank lines in the header - (while (re-search-forward "\n\n\n*" nil t) - (replace-match "\n"))) + (while (progn (goto-char (point-min)) + (re-search-forward "\n[ \t]*\n\n*" nil t)) + (replace-match "\n")) + (goto-char (point-min)) + (while (re-search-forward + "^[^ \t\n:]+:[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n" + nil t) + (when (string= "" (match-string 1)) + (replace-match "")))) ;;; (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock (wl-draft-dispatch-message) (when kill-when-done diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index 94fcee6..9c95808 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -818,7 +818,7 @@ elmo-msgdb-new-mark))) (setq fsymbol 'wl-highlight-summary-low-unread-face)) ((setq action (assoc temp-mark wl-summary-mark-action-list)) - (setq fsymbol (nth 4 action))) + (setq fsymbol (nth 5 action))) ((string= mark elmo-msgdb-new-mark) (setq fsymbol 'wl-highlight-summary-new-face)) ((member mark (list elmo-msgdb-unread-cached-mark @@ -854,7 +854,7 @@ (setq status-mark (wl-summary-persistent-mark)) (setq temp-mark (wl-summary-temp-mark)) (when (setq action (assoc temp-mark wl-summary-mark-action-list)) - (setq fsymbol (nth 4 action))) + (setq fsymbol (nth 5 action))) (if (not fsymbol) (cond ((and (string= temp-mark wl-summary-score-over-mark) diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 40712b8..095cab7 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -287,7 +287,7 @@ See also variable `wl-use-petname'." ["Mark as read" wl-summary-mark-as-read t] ["Mark as important" wl-summary-mark-as-important t] ["Mark as unread" wl-summary-mark-as-unread t] - ["Set delete mark" wl-summary-delete t] + ["Set dispose mark" wl-summary-dispose t] ["Set refile mark" wl-summary-refile t] ["Set copy mark" wl-summary-copy t] ["Prefetch" wl-summary-prefetch t] @@ -320,7 +320,7 @@ See also variable `wl-use-petname'." ["Mark as read" wl-summary-mark-as-read-region t] ["Mark as important" wl-summary-mark-as-important-region t] ["Mark as unread" wl-summary-mark-as-unread-region t] - ["Set delete mark" wl-summary-delete-region t] + ["Set dispose mark" wl-summary-dispose-region t] ["Set refile mark" wl-summary-refile-region t] ["Set copy mark" wl-summary-copy-region t] ["Prefetch" wl-summary-prefetch-region t] @@ -462,10 +462,10 @@ See also variable `wl-use-petname'." (define-key wl-summary-mode-map "O" 'wl-summary-copy) (define-key wl-summary-mode-map "\M-o" 'wl-summary-refile-prev-destination) (define-key wl-summary-mode-map "\C-o" 'wl-summary-auto-refile) - (define-key wl-summary-mode-map "d" 'wl-summary-delete) + (define-key wl-summary-mode-map "d" 'wl-summary-dispose) (define-key wl-summary-mode-map "u" 'wl-summary-unmark) (define-key wl-summary-mode-map "U" 'wl-summary-unmark-all) - (define-key wl-summary-mode-map "D" 'wl-summary-erase) + (define-key wl-summary-mode-map "D" 'wl-summary-delete) ;; thread commands (define-key wl-summary-mode-map "t" (make-sparse-keymap)) @@ -501,7 +501,7 @@ See also variable `wl-use-petname'." (define-key wl-summary-mode-map "m?" 'wl-summary-target-mark-pick) (define-key wl-summary-mode-map "m#" 'wl-summary-target-mark-print) (define-key wl-summary-mode-map "m|" 'wl-summary-target-mark-pipe) - (define-key wl-summary-mode-map "mD" 'wl-summary-target-mark-erase) + (define-key wl-summary-mode-map "mD" 'wl-summary-target-mark-delete) ;; region commands (define-key wl-summary-mode-map "r" (make-sparse-keymap)) @@ -512,8 +512,8 @@ See also variable `wl-use-petname'." (define-key wl-summary-mode-map "r*" 'wl-summary-target-mark-region) (define-key wl-summary-mode-map "ro" 'wl-summary-refile-region) (define-key wl-summary-mode-map "rO" 'wl-summary-copy-region) - (define-key wl-summary-mode-map "rd" 'wl-summary-delete-region) - (define-key wl-summary-mode-map "rD" 'wl-summary-erase-region) + (define-key wl-summary-mode-map "rd" 'wl-summary-dispose-region) + (define-key wl-summary-mode-map "rD" 'wl-summary-delete-region) (define-key wl-summary-mode-map "ru" 'wl-summary-unmark-region) (define-key wl-summary-mode-map "r!" 'wl-summary-mark-as-unread-region) (define-key wl-summary-mode-map "r$" 'wl-summary-mark-as-important-region) @@ -1461,7 +1461,8 @@ If ARG is non-nil, checking is omitted." (wl-thread-get-entity (car targets)))) (progn (wl-summary-jump-to-msg (car targets)) - (wl-summary-prefetch)) + (wl-summary-prefetch-msg + (wl-summary-message-number))) (wl-summary-prefetch-msg (car targets)))) (if (if prefetch-marks (string= mark elmo-msgdb-unread-cached-mark) @@ -1481,15 +1482,6 @@ If ARG is non-nil, checking is omitted." (message "Prefetched %d/%d message(s)" count length) (cons count length))))) -(defun wl-summary-prefetch-region (beg end) - (interactive "r") - (wl-summary-mark-region-subr 'wl-summary-prefetch beg end)) - -(defun wl-summary-prefetch (&optional number) - "Prefetch current message." - (interactive) - (wl-summary-set-mark "i" number (interactive-p) nil)) - (defun wl-summary-delete-marks-on-buffer (marks) (while marks (wl-summary-unmark (pop marks)))) @@ -1498,7 +1490,6 @@ If ARG is non-nil, checking is omitted." (wl-summary-delete-marks-on-buffer copies)) ;;; - (defun wl-summary-delete-all-target-marks () (wl-summary-delete-marks-on-buffer wl-summary-buffer-target-mark-list)) @@ -1766,25 +1757,6 @@ If ARG is non-nil, checking is omitted." (if wl-summary-highlight (wl-highlight-summary-current-line))) (forward-line 1))))) -(defun wl-summary-get-delete-folder (folder) - (if (string= folder wl-trash-folder) - 'null - (let* ((type (or (wl-get-assoc-list-value wl-delete-folder-alist folder) - 'trash))) - (cond ((stringp type) - type) - ((or (equal type 'remove) (equal type 'null)) - 'null) - (t;; (equal type 'trash) - (let ((trash-folder (wl-folder-get-elmo-folder wl-trash-folder))) - (unless (elmo-folder-exists-p trash-folder) - (if (y-or-n-p - (format "Trash Folder %s does not exist, create it? " - wl-trash-folder)) - (elmo-folder-create trash-folder) - (error "Trash Folder is not created")))) - wl-trash-folder))))) - (defun wl-summary-insert-message (&rest args) (if (eq wl-summary-buffer-view 'thread) (apply 'wl-summary-insert-thread args) @@ -2729,870 +2701,6 @@ If ARG, without confirm." (wl-thread-make-indent-string thr-entity) (wl-thread-entity-get-linked thr-entity))))))) -;; 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. -DATA is passed to the set-action function of the action as an argument. -Return number if put mark succeed" - (let* ((set-mark (or set-mark - (completing-read "Mark: " wl-summary-mark-action-list))) - (current (wl-summary-message-number)) - (action (assoc set-mark wl-summary-mark-action-list)) - visible mark) - (save-excursion - ;; Put mark - (setq visible (or - ;; not-interactive and visible - (and number (wl-summary-jump-to-msg number)) - ;; interactive - (and (null number) current)) - number (or number current)) - ;; Put mark on the current line. - (funcall (nth 1 action) (nth 0 action) number visible - (or interactive (interactive-p)) data) - (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))) - ;; Return value. - number)) - -(defun wl-summary-register-target-mark (number) - (or (memq number wl-summary-buffer-target-mark-list) - (setq wl-summary-buffer-target-mark-list - (cons number wl-summary-buffer-target-mark-list)))) - -(defun wl-summary-unregister-target-mark (number) - (delq number wl-summary-buffer-target-mark-list)) - -(defun wl-summary-have-target-mark-p (number) - (memq number wl-summary-buffer-target-mark-list)) - -;; wl-summary-buffer-temp-mark-list specification -;; ((1 "D" nil)(2 "o" "+fuga")(3 "O" "+hoge")) -(defun wl-summary-register-temp-mark (number mark mark-info) - (let ((elem (assq number wl-summary-buffer-temp-mark-list))) - (setq wl-summary-buffer-temp-mark-list - (delq elem wl-summary-buffer-temp-mark-list))) - (setq wl-summary-buffer-temp-mark-list - (cons (list number mark mark-info) wl-summary-buffer-temp-mark-list))) - -(defun wl-summary-unregister-temp-mark (number) - (let ((elem (assq number wl-summary-buffer-temp-mark-list))) - (setq wl-summary-buffer-temp-mark-list - (delq elem wl-summary-buffer-temp-mark-list)))) - -(defun wl-summary-registered-temp-mark (number) - (assq number wl-summary-buffer-temp-mark-list)) - -(defun wl-summary-collect-temp-mark (mark &optional begin end) - (if (or begin end) - (save-excursion - (save-restriction - (let (mark-list) - (narrow-to-region (or begin (point-min))(or end (point-max))) - (goto-char (point-min)) - ;; for thread... - (if (eq wl-summary-buffer-view 'thread) - (let (number entity mark-info) - (while (not (eobp)) - (setq number (wl-summary-message-number) - entity (wl-thread-get-entity number) - mark-info (wl-summary-registered-temp-mark number)) - ;; toplevel message mark. - (when (string= (nth 1 mark-info) mark) - (setq mark-list (cons mark-info mark-list))) - ;; When thread is closed...children should also be checked. - (unless (wl-thread-entity-get-opened entity) - (dolist (msg (wl-thread-get-children-msgs number)) - (setq mark-info (wl-summary-registered-temp-mark - msg)) - (when (string= (nth 1 mark-info) mark) - (setq mark-list (cons mark-info mark-list))))) - (forward-line 1))) - (let (number mark-info) - (while (not (eobp)) - (setq number (wl-summary-message-number) - mark-info (wl-summary-registered-temp-mark number)) - (when (string= (nth 1 mark-info) mark) - (setq mark-list (cons mark-info mark-list))) - (forward-line 1)))) - mark-list))) - (let (mark-list) - (dolist (mark-info wl-summary-buffer-temp-mark-list) - (when (string= (nth 1 mark-info) mark) - (setq mark-list (cons mark-info mark-list)))) - mark-list))) - -;; Unset mark -(defun wl-summary-unset-mark (&optional number interactive) - "Unset temporary mark of the message with NUMBER. -NUMBER is the message number to unset the mark. -If not specified, the message on the cursor position is treated. -Optional INTERACTIVE is non-nil when it should be called interactively. -Return number if put mark succeed" - (interactive) - (save-excursion - (beginning-of-line) - (let ((buffer-read-only nil) - visible mark action) - (if number - (setq visible (wl-summary-jump-to-msg number)) - (setq visible t)) - (setq number (or number (wl-summary-message-number))) - ;; Delete mark on buffer. - (when visible - (setq mark (wl-summary-temp-mark)) - (unless (string= mark " ") - (delete-backward-char 1) - (insert (or (wl-summary-get-score-mark number) - " ")) - (setq action (assoc mark wl-summary-mark-action-list)) - (funcall (nth 2 action) number)) - (set-buffer-modified-p nil)) - ;; Remove from temporal mark structure. - (wl-summary-unregister-target-mark number) - (wl-summary-unregister-temp-mark number))) - ;; 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 (dest-numbers dest-number) - (dolist (elem mark-list) - (setq dest-number (assoc (nth 2 elem) dest-numbers)) - (if dest-number - (unless (memq (car elem) (cdr dest-number)) - (nconc dest-number (list (car elem)))) - (setq dest-numbers (nconc dest-numbers - (list - (list (nth 2 elem) - (car elem))))))) - dest-numbers)) - -(defun wl-summary-move-mark-list-messages (mark-list folder-name message) - (if (null mark-list) - (message "No marks") - (save-excursion - (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. - (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)) - (wl-summary-buffer-msgdb) - (not (null (cdr dst-msgs))) - nil ; no-delete - nil ; same-number - t)) - (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) - (wl-summary-set-message-modified) - ;; Return the operation failed message numbers. - (if result - 0 - (length refiles)))))) - -;;; Actions -(defun wl-summary-set-action-generic (mark number visible interactive data) - (when visible - ;; Note that the cursor is on the target message at this moment. - (let ((cur-mark (wl-summary-temp-mark))) - (if (wl-summary-reserve-temp-mark-p cur-mark) - (if interactive - (error "%s is already marked as `%s'" number cur-mark)) - ;; Remove current mark. - (wl-summary-unset-mark))) - (wl-summary-mark-line mark) - (when (and visible - wl-summary-highlight) - (wl-highlight-summary-current-line))) - (wl-summary-register-temp-mark number mark nil)) - -(defun wl-summary-unset-action-generic (number) - ;; Just unhighlight. - (when wl-summary-highlight - (wl-highlight-summary-current-line))) - -;; Target mark handling. -(defun wl-summary-set-target-mark (mark number visible interactive data) - (when visible - ;; Note that the cursor is on the target message at this moment. - (let ((cur-mark (wl-summary-temp-mark))) - (if (wl-summary-reserve-temp-mark-p cur-mark) - (if interactive - (error "%s is already marked as `%s'" number cur-mark)) - ;; Remove current mark. - (wl-summary-unset-mark))) - (wl-summary-mark-line mark) - (when (and visible - wl-summary-highlight) - (wl-highlight-summary-current-line))) - (wl-summary-register-target-mark number)) - -(defun wl-summary-unset-target-mark (number) - ;; Just unhighlight. - (when wl-summary-highlight - (wl-highlight-summary-current-line))) - -;; Delete action. -(defun wl-summary-delete (&optional number) - (interactive) - (wl-summary-set-mark "d" number (interactive-p))) - -(defun wl-summary-delete-region (beg end) - (interactive "r") - (wl-summary-mark-region-subr 'wl-summary-delete beg end)) - -(defun wl-summary-target-mark-delete () - (interactive) - (wl-summary-target-mark-replace "d")) - -(defun wl-summary-exec-action-delete (mark-list) - (wl-summary-move-mark-list-messages mark-list - (wl-summary-get-delete-folder - (wl-summary-buffer-folder-name)) - "Deleting messages...")) - -;; Erase action. -(defun wl-summary-erase (&optional number) - (interactive) - (wl-summary-set-mark "D" number (interactive-p))) - -(defun wl-summary-target-mark-erase () - (interactive) - (wl-summary-target-mark-replace "D")) - -(defun wl-summary-erase-region (beg end) - (interactive "r") - (wl-summary-mark-region-subr 'wl-summary-erase beg end)) - -(defun wl-summary-exec-action-erase (mark-list) - (wl-summary-move-mark-list-messages mark-list - 'null - "Erasing messages...")) - -;; Refile action -(defun wl-summary-refile (&optional dst number) - "Put refile mark on current line message. -If optional argument DST is specified, put mark without asking -destination folder. -If optional argument NUMBER is specified, mark message specified by NUMBER. - -If folder is read-only, message should be copied. -See `wl-refile-policy-alist' for more details." - (interactive) - (let ((policy (wl-get-assoc-list-value wl-refile-policy-alist - (wl-summary-buffer-folder-name)))) - (cond ((eq policy 'copy) - (wl-summary-set-mark "O" number (interactive-p) dst) - (run-hooks 'wl-summary-copy-hook)) - (t - (wl-summary-set-mark "o" number (interactive-p) dst) - (run-hooks 'wl-summary-refile-hook))))) - -(defun wl-summary-refile-region (beg end) - "Put refile mark on messages in the region specified by BEG and END." - (interactive "r") - (wl-summary-refile-region-subr "refile" beg end)) - -(defun wl-summary-target-mark-refile () - (interactive) - (wl-summary-target-mark-refile-subr "refile" "o")) - -(defun wl-summary-set-action-refile (mark number visible interactive data) - (wl-summary-set-action-refile-subr - 'refile mark number visible interactive data)) - -(defun wl-summary-set-action-refile-subr (copy-or-refile - mark number visible - interactive dst) - (let* ((buffer-num (wl-summary-message-number)) - (msg-num (or number buffer-num)) - (msgid (and msg-num - (elmo-message-field wl-summary-buffer-elmo-folder - msg-num 'message-id))) - (entity (and msg-num - (elmo-msgdb-overview-get-entity - msg-num (wl-summary-buffer-msgdb)))) - folder cur-mark already tmp-folder) - (catch 'done - (when (null entity) - ;; msgdb is empty? - (if interactive - (message "Cannot refile.")) - (throw 'done nil)) - (when (null msg-num) - (if interactive - (message "No message.")) - (throw 'done nil)) - (when (setq cur-mark (nth 1 (wl-summary-registered-temp-mark number))) - (when (wl-summary-reserve-temp-mark-p cur-mark) - (if interactive - (error "Already marked as `%s'" cur-mark)) - (throw 'done nil))) - (setq folder (and msg-num - (or dst (wl-summary-read-folder - (or (wl-refile-guess entity) wl-trash-folder) - (format "for %s " copy-or-refile))))) - ;; Cache folder hack by okada@opaopa.org - (when (and (eq (elmo-folder-type-internal - (wl-folder-get-elmo-folder - (wl-folder-get-realname folder))) 'cache) - (not (string= folder - (setq tmp-folder - (concat "'cache/" - (elmo-cache-get-path-subr - (elmo-msgid-to-cache msgid))))))) - (setq folder tmp-folder) - (message "Force refile to %s." folder)) - (if (string= folder (wl-summary-buffer-folder-name)) - (error "Same folder")) - (if (or (not (elmo-folder-writable-p (wl-folder-get-elmo-folder folder))) - (string= folder wl-queue-folder) - (string= folder wl-draft-folder)) - (error "Don't set as target: %s" folder)) - ;; learn for refile. - (when (eq copy-or-refile 'refile) - (wl-refile-learn entity folder)) - (wl-summary-unset-mark msg-num) - (when visible - (wl-summary-mark-line mark) - (when wl-summary-highlight - (wl-highlight-summary-current-line)) - ;; print refile destination - (wl-summary-print-destination msg-num folder)) - (wl-summary-register-temp-mark msg-num mark folder) - (setq wl-summary-buffer-prev-refile-destination folder) - msg-num))) - -(defun wl-summary-unset-action-refile (number) - ;; Just unhighlight. - (when wl-summary-highlight - (wl-highlight-summary-current-line)) - (wl-summary-remove-destination)) - -(defun wl-summary-exec-action-refile (mark-list) - (save-excursion - (let ((del-fld (wl-summary-get-delete-folder - (wl-summary-buffer-folder-name))) - (start (point)) - (failures 0) - (refile-len (length mark-list)) - dst-msgs ; loop counter - result) - ;; 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 "Moving 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))) - (wl-summary-buffer-msgdb) - (not (null (cdr dst-msgs))) - nil ; no-delete - nil ; same-number - t)) - (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) - failures))) - -;; Copy action -(defun wl-summary-copy (&optional dst number) - "Put copy mark on current line message. -If optional argument DST is specified, put mark without asking -destination folder. -If optional argument NUMBER is specified, mark message specified by NUMBER." - (interactive) - (wl-summary-set-mark "O" number (interactive-p) dst)) - -(defun wl-summary-target-mark-copy () - (interactive) - (wl-summary-target-mark-refile-subr "copy" "O")) - -(defun wl-summary-copy-region (beg end) - "Put copy mark on messages in the region specified by BEG and END." - (interactive "r") - (wl-summary-refile-region-subr "copy" beg end)) - -(defun wl-summary-set-action-copy (mark number visible interactive data) - (wl-summary-set-action-refile-subr - 'copy mark number visible interactive data)) - -(defun wl-summary-unset-action-copy (number) - ;; Just unhighlight. - (when wl-summary-highlight - (wl-highlight-summary-current-line)) - (wl-summary-remove-destination)) - -(defun wl-summary-exec-action-copy (mark-list) - (save-excursion - (let ((del-fld (wl-summary-get-delete-folder - (wl-summary-buffer-folder-name))) - (start (point)) - (failures 0) - (refile-len (length mark-list)) - dst-msgs ; loop counter - result) - ;; 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))) - (wl-summary-buffer-msgdb) - (not (null (cdr dst-msgs))) - t ; t is no-delete (copy) - nil ; same-number - t)) - (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) - failures))) - -;; Prefetch. -(defun wl-summary-target-mark-prefetch () - (interactive) - (wl-summary-target-mark-replace "i")) - -(defun wl-summary-exec-action-prefetch (mark-list) - (save-excursion - (let* ((buffer-read-only nil) - (count 0) - (length (length mark-list)) - (mark-list-copy (copy-sequence mark-list)) - (pos (point)) - (failures 0) - new-mark) - (dolist (mark-info mark-list-copy) - (message "Prefetching...(%d/%d)" - (setq count (+ 1 count)) length) - (setq new-mark (wl-summary-prefetch-msg (car mark-info))) - (if new-mark - (progn - (wl-summary-unset-mark (car mark-info)) - (when (wl-summary-jump-to-msg (car mark-info)) - (wl-summary-persistent-mark) ; move - (delete-backward-char 1) - (insert new-mark) - (when wl-summary-highlight - (wl-highlight-summary-current-line)) - (save-excursion - (goto-char pos) - (sit-for 0)))) - (incf failures))) - (message "Prefetching...done") - 0))) - -(defun wl-summary-remove-destination () - (save-excursion - (let ((inhibit-read-only t) - (buffer-read-only nil) - (buf (current-buffer)) - sol eol rs re) - (beginning-of-line) - (setq sol (point)) - (search-forward "\r") - (forward-char -1) - (setq eol (point)) - (setq rs (next-single-property-change sol 'wl-summary-destination - buf eol)) - (setq re (next-single-property-change rs 'wl-summary-destination - buf eol)) - (put-text-property rs re 'wl-summary-destination nil) - (put-text-property rs re 'invisible nil) - (goto-char re) - (delete-char (- eol re))))) - -(defun wl-summary-collect-numbers-region (begin end) - "Return a list of message number in the region specified by BEGIN and END." - (save-excursion - (save-restriction - (let (numbers) - (narrow-to-region (or begin (point-min))(or end (point-max))) - (goto-char (point-min)) - ;; for thread... - (if (eq wl-summary-buffer-view 'thread) - (let (number entity mark-info) - (while (not (eobp)) - (setq numbers (cons (wl-summary-message-number) numbers) - entity (wl-thread-get-entity number)) - ;; When thread is closed...children should also be checked. - (unless (wl-thread-entity-get-opened entity) - (dolist (msg (wl-thread-get-children-msgs number)) - (setq numbers (cons msg numbers)))) - (forward-line 1))) - (let (number mark-info) - (while (not (eobp)) - (setq numbers (cons (wl-summary-message-number) numbers)) - (forward-line 1)))) - 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 (car 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)))) - ;; 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) (nth 3 action)) - (setq modified t) - (setq failures (+ failures (funcall (nth 3 action) (cdr pair)))))) - (when modified - (wl-summary-set-message-modified)) - (run-hooks 'wl-summary-exec-hook) - ;; message buffer is not up-to-date - (unless (and wl-message-buffer - (eq (wl-summary-message-number) - (with-current-buffer wl-message-buffer - wl-message-buffer-cur-number))) - (wl-summary-toggle-disp-msg 'off) - (setq wl-message-buffer nil)) - (set-buffer-modified-p nil) - (message "Executing...done%s" - (if (> failures 0) - (format " (%d failed)" failures) - "")))) - -(defun wl-summary-exec-region (beg end) - (interactive "r") - (wl-summary-exec - (wl-summary-collect-numbers-region beg end))) - -(defun wl-summary-read-folder (default &optional purpose ignore-error - no-create init) - (let ((fld (completing-read - (format "Folder name %s(%s): " (or purpose "") - default) - 'wl-folder-complete-folder - nil nil (or init wl-default-spec) - 'wl-read-folder-hist))) - (if (or (string= fld wl-default-spec) - (string= fld "")) - (setq fld default)) - (setq fld (elmo-string (wl-folder-get-realname fld))) - (if (string-match "\n" fld) - (error "Not supported folder name: %s" fld)) - (unless no-create - (if ignore-error - (condition-case nil - (wl-folder-confirm-existence - (wl-folder-get-elmo-folder - fld)) - (error)) - (wl-folder-confirm-existence (wl-folder-get-elmo-folder - fld)))) - fld)) - -(defun wl-summary-print-destination (msg-num folder) - "Print refile destination on line." - (wl-summary-remove-destination) - (save-excursion - (let ((inhibit-read-only t) - (folder (copy-sequence folder)) - (buffer-read-only nil) - len rs re c) - (setq len (string-width folder)) - (if (< len 1) () - ;;(end-of-line) - (beginning-of-line) - (search-forward "\r") - (forward-char -1) - (setq re (point)) - (setq c 0) - (while (< c len) - (forward-char -1) - (setq c (+ c (char-width (following-char))))) - (and (> c len) (setq folder (concat " " folder))) - (setq rs (point)) - (when wl-summary-width - (put-text-property rs re 'invisible t)) - (put-text-property rs re 'wl-summary-destination t) - (goto-char re) - (wl-highlight-refile-destination-string folder) - (insert folder) - (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)) - -(defun wl-summary-refile-prev-destination () - "Refile message to previously refiled destination." - (interactive) - (wl-summary-refile wl-summary-buffer-prev-refile-destination - (wl-summary-message-number)) - (if (eq wl-summary-move-direction-downward nil) - (wl-summary-prev) - (wl-summary-next))) - -(defsubst wl-summary-no-auto-refile-message-p (msg) - (member (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg) - wl-summary-auto-refile-skip-marks)) - -(defun wl-summary-auto-refile (&optional open-all) - "Set refile mark automatically according to 'wl-refile-guess-by-rule'." - (interactive "P") - (message "Marking...") - (save-excursion - (if (and (eq wl-summary-buffer-view 'thread) - open-all) - (wl-thread-open-all)) - (let* ((spec (wl-summary-buffer-folder-name)) - checked-dsts - (count 0) - number dst thr-entity) - (goto-line 1) - (while (not (eobp)) - (setq number (wl-summary-message-number)) - (dolist (number (cons number - (and (eq wl-summary-buffer-view 'thread) - ;; process invisible children. - (not (wl-thread-entity-get-opened - (setq thr-entity - (wl-thread-get-entity number)))) - (wl-thread-entity-get-descendant - thr-entity)))) - (when (and (not (wl-summary-no-auto-refile-message-p - number)) - (setq dst - (wl-folder-get-realname - (wl-refile-guess-by-rule - (elmo-msgdb-overview-get-entity - number (wl-summary-buffer-msgdb))))) - (not (equal dst spec)) - (let ((pair (assoc dst checked-dsts)) - ret) - (if pair - (cdr pair) - (setq ret - (condition-case nil - (progn - (wl-folder-confirm-existence - (wl-folder-get-elmo-folder dst)) - t) - (error))) - (setq checked-dsts (cons (cons dst ret) checked-dsts)) - ret))) - (if (wl-summary-refile dst number) - (incf count)) - (message "Marking...%d message(s)." count))) - (forward-line)) - (if (eq count 0) - (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." - (interactive) - (wl-summary-unset-mark number (interactive-p))) - -(defun wl-summary-target-mark (&optional number) - "Put target mark '*' on current message. -If optional argument NUMBER is specified, mark message specified by NUMBER." - (interactive) - (wl-summary-set-mark "*" number (interactive-p))) - -(defun wl-summary-refile-region-subr (copy-or-refile beg end) - (save-excursion - (save-restriction - (goto-char beg) - ;; guess by first msg - (let* ((msgid (cdr (assq (wl-summary-message-number) - (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb))))) - (function (intern (format "wl-summary-%s" copy-or-refile))) - (entity (assoc msgid (elmo-msgdb-get-overview - (wl-summary-buffer-msgdb)))) - folder) - (if entity - (setq folder (wl-summary-read-folder (wl-refile-guess entity) - (format "for %s" - copy-or-refile)))) - (narrow-to-region beg end) - (if (eq wl-summary-buffer-view 'thread) - (progn - (while (not (eobp)) - (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - children) - (if (wl-thread-entity-get-opened entity) - ;; opened...refile line. - (funcall function folder number) - ;; closed - (setq children (wl-thread-get-children-msgs number)) - (while children - (funcall function folder (pop children)))) - (forward-line 1)))) - (while (not (eobp)) - (funcall function folder (wl-summary-message-number)) - (forward-line 1))))))) - -(defun wl-summary-unmark-region (beg end) - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (if (eq wl-summary-buffer-view 'thread) - (progn - (while (not (eobp)) - (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number))) - (if (wl-thread-entity-get-opened entity) - ;; opened...unmark line. - (wl-summary-unmark) - ;; closed - (wl-summary-delete-marks-on-buffer - (wl-thread-get-children-msgs number)))) - (forward-line 1))) - (while (not (eobp)) - (wl-summary-unmark) - (forward-line 1)))))) - -(defun wl-summary-mark-region-subr (function beg end) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (if (eq wl-summary-buffer-view 'thread) - (progn - (while (not (eobp)) - (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - (wl-summary-move-direction-downward t) - children) - (if (wl-thread-entity-get-opened entity) - ;; opened...delete line. - (funcall function number) - ;; closed - (setq children (wl-thread-get-children-msgs number)) - (while children - (funcall function (pop children)))) - (forward-line 1)))) - (while (not (eobp)) - (funcall function (wl-summary-message-number)) - (forward-line 1)))))) - -(defun wl-summary-target-mark-region (beg end) - (interactive "r") - (wl-summary-mark-region-subr 'wl-summary-target-mark beg end)) - -(defun wl-summary-target-mark-all () - (interactive) - (wl-summary-target-mark-region (point-min) (point-max)) - (setq wl-summary-buffer-target-mark-list - (mapcar 'car - (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))))) - -(defun wl-summary-delete-all-mark (mark) - (goto-char (point-min)) - (while (not (eobp)) - (when (string= (wl-summary-temp-mark) mark) - (wl-summary-unmark)) - (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))))) - -(defun wl-summary-unmark-all () - "Unmark all according to what you input." - (interactive) - (let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: "))) - cur-mark) - (save-excursion - (while unmarks - (setq cur-mark (char-to-string (car unmarks))) - (wl-summary-delete-all-mark cur-mark) - (setq unmarks (cdr unmarks)))))) - -(defun wl-summary-target-mark-thread () - (interactive) - (wl-thread-call-region-func 'wl-summary-target-mark-region t)) - (defun wl-summary-target-mark-msgs (msgs) "Return the number of marked messages." (let ((i 0) num) @@ -3696,64 +2804,6 @@ If ARG, exit virtual folder." (delete-backward-char 1) (insert mark)))) -(defun wl-summary-target-mark-replace (mark) - (save-excursion - (goto-char (point-min)) - (let (number mlist) - (while (not (eobp)) - (when (string= (wl-summary-temp-mark) "*") - (let (wl-summary-buffer-disp-msg) - (when (setq number (wl-summary-message-number)) - (wl-summary-set-mark mark number) - (setq wl-summary-buffer-target-mark-list - (delq number wl-summary-buffer-target-mark-list))))) - (forward-line 1)) - (setq mlist wl-summary-buffer-target-mark-list) - (while mlist - (wl-summary-register-temp-mark (car mlist) mark nil) - (setq wl-summary-buffer-target-mark-list - (delq (car mlist) wl-summary-buffer-target-mark-list)) - (setq mlist (cdr mlist)))))) - -(defun wl-summary-target-mark-refile-subr (copy-or-refile mark) - (let ((numlist wl-summary-buffer-number-list) - (function - (intern (format "wl-summary-%s" copy-or-refile))) - regexp number msgid entity folder mlist) - (save-excursion - ;; guess by first mark - (while numlist - (if (memq (car numlist) wl-summary-buffer-target-mark-list) - (setq number (car numlist) - numlist nil)) - (setq numlist (cdr numlist))) - (when number - (setq msgid (elmo-message-field wl-summary-buffer-elmo-folder - number 'message-id) - entity (elmo-msgdb-overview-get-entity - number (wl-summary-buffer-msgdb))) - (if (null entity) - (error "Cannot %s" copy-or-refile)) - (setq folder (wl-summary-read-folder - (wl-refile-guess entity) - (format "for %s" copy-or-refile))) - (goto-char (point-min)) - (while (not (eobp)) - (when (string= (wl-summary-temp-mark) "*") - (let (wl-summary-buffer-disp-msg) - (when (setq number (wl-summary-message-number)) - (funcall function folder number) - (setq wl-summary-buffer-target-mark-list - (delq number wl-summary-buffer-target-mark-list))))) - (forward-line 1)) - ;; process invisible messages. - (setq mlist wl-summary-buffer-target-mark-list) - (while mlist - (wl-summary-register-temp-mark (car mlist) mark folder) - (setq wl-summary-buffer-target-mark-list - (delq (car mlist) wl-summary-buffer-target-mark-list)) - (setq mlist (cdr mlist))))))) - (defun wl-summary-next-buffer () "Switch to next summary buffer." (interactive) diff --git a/wl/wl-vars.el b/wl/wl-vars.el index 16b4283..857ea73 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -335,48 +335,71 @@ If nil, never search search parent by subject." ;;; Mark & Action (defcustom wl-summary-mark-action-list '(("*" - wl-summary-set-target-mark - wl-summary-unset-target-mark + target-mark nil - wl-highlight-summary-temp-face) + wl-summary-register-target-mark + nil + wl-highlight-summary-temp-face + "put target mark.") ("d" - wl-summary-set-action-generic - wl-summary-unset-action-generic - wl-summary-exec-action-delete - wl-highlight-summary-deleted-face) + dispose + nil + wl-summary-register-temp-mark + wl-summary-exec-action-dispose + wl-highlight-summary-deleted-face + "dispose messages according to `wl-dispose-folder-alist'.") ("D" - wl-summary-set-action-generic - wl-summary-unset-action-generic - wl-summary-exec-action-erase - wl-highlight-summary-erased-face) + delete + nil + wl-summary-register-temp-mark + wl-summary-exec-action-delete + wl-highlight-summary-erased-face + "delete messages immediately.") ("o" + refile + wl-summary-get-refile-destination wl-summary-set-action-refile - wl-summary-unset-action-refile wl-summary-exec-action-refile - wl-highlight-summary-refiled-face) + wl-highlight-summary-refiled-face + "refile messages to the other folder.") ("O" - wl-summary-set-action-copy - wl-summary-unset-action-copy + copy + wl-summary-get-copy-destination + wl-summary-register-temp-mark wl-summary-exec-action-copy - wl-highlight-summary-copied-face) + wl-highlight-summary-copied-face + "copy messages to the other folder.") ("i" - wl-summary-set-action-generic - wl-summary-unset-action-generic + prefetch + nil + wl-summary-register-temp-mark wl-summary-exec-action-prefetch - wl-highlight-summary-prefetch-face)) + wl-highlight-summary-prefetch-face + "prefetch messages.")) "A variable to define Mark & Action. Each element of the list should be a list of -\(MARK SET-MARK-FUNCTION UNSET-MARK-FUNCTION EXEC-FUNCTION FACE) +\(MARK + SYMBOL + ARGUMENT-FUNCTION + SET-MARK-FUNCTION + EXEC-FUNCTION + FACE) + MARK is a temporal mark string to define. +SYMBOL is an action name to define. +ARGUMENT-FUNCTION is a function called to set the argument data for +SET-MARK-FUNCTION. +Its argument is (ACTION NUMBER). +ACTION is same as the SYMBOL. +NUMBER is the message number to determine the argument data. SET-MARK-FUNCTION is a function called to set the mark. -Its argument is (MARK NUMBER VISIBLE INTERACTIVE DATA). -UNSET-MARK-FUNCTION is a function called to unset the mark. -Its argument is (NUMBER). +Its argument is (NUMBER MARK DATA). +NUMBER is the target message number. +MARK is the temporary mark string. +DATA is given by ARGUMENT-FUNCTION. EXEC-FUNCTION is a function called to execute the action. Its argument is a list of MARK-INFO. MARK-INFO is a list of (NUMBER MARK DATA). -DATA is the value which should be specified by `wl-summary-register-temp-mark' -in the SET-MARK-FUNCTION. FACE is a face for highlighting." :type '(repeat (string :tag "Temporary mark") (symbol :tag "Set mark function") @@ -2174,9 +2197,9 @@ Sender information in summary mode." :type 'string :group 'wl-folder) -(defcustom wl-delete-folder-alist '(("^-" . remove) - ("^@" . remove)) - "*Alist of folder and delete policy. +(defcustom wl-dispose-folder-alist '(("^-" . remove) + ("^@" . remove)) + "*Alist of folder and dispose policy. Each element is (folder-regexp . policy). The policy is one of the followings: diff --git a/wl/wl.el b/wl/wl.el index c4ca68d..e076fa3 100644 --- a/wl/wl.el +++ b/wl/wl.el @@ -56,6 +56,7 @@ (provide 'wl) ; circular dependency (require 'wl-folder) (require 'wl-summary) +(require 'wl-action) (require 'wl-thread) (require 'wl-address) (require 'wl-news) @@ -695,6 +696,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (symbol-value 'wl-summary-subject-function)) (fset 'wl-summary-subject-filter-func-internal (symbol-value 'wl-summary-subject-filter-function)) + (wl-summary-define-mark-action) (setq elmo-no-from wl-summary-no-from-message) (setq elmo-no-subject wl-summary-no-subject-message) (wl-news-check)