From: teranisi Date: Thu, 24 Jul 2003 04:48:26 +0000 (+0000) Subject: elmo-mark branch is merged. X-Git-Tag: wl-2_11_5~45 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=10c9f47884508cec3b96340be0b4118938633e51;p=elisp%2Fwanderlust.git elmo-mark branch is merged. --- diff --git a/ChangeLog b/ChangeLog index bc75d74..b2751d4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2003-07-19 Hiroya Murata + + * etc/icons/wl-summary-dispose-up.xpm: New file. + +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/elmo/ChangeLog b/elmo/ChangeLog index f02abb8..e445b78 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -2,8 +2,165 @@ * elmo-version.el (elmo-version): Up to 2.11.4. +2003-07-23 Hiroya Murata + + * elmo-pipe.el (elmo-folder-unmark-answered): Define. + (elmo-folder-mark-as-answered): Ditto. + +2003-07-22 Yuuichi Teranishi + + * elmo-pop3.el (elmo-pop3-exists-exactly): Set default value as nil. + (elmo-pop3-get-session): Make msgdb directory after session. + (elmo-folder-exists-p): Check exactly at the first time even when the + elmo-pop3-exists-exactly is nil. + + * elmo-pipe.el (elmo-folder-open-internal): Don't drain here. + (elmo-folder-list-messages): Define instead of + elmo-folder-list-messages-internal. + (elmo-folder-check): Check destination folder. + (elmo-folder-synchronize): Drain the pipe. + + * elmo-localdir.el (elmo-folder-append-messages): Don't cause an error + when msgdb is not loaded. + + * elmo-msgdb.el (elmo-msgdb-append-to-killed-list): Abolish. + + * elmo-imap4.el (elmo-folder-list-messages-plugged): Fixed. + (elmo-imap4-folder-diff-plugged): Use uidnext to calculate number of + messages. + + * elmo.el (elmo-folder-kill-messages-before): New function. + (elmo-folder-kill-messages): Ditto. + (elmo-folder-synchronize): Use elmo-folder-kill-messages-before. + + * elmo-imap4.el (elmo-folder-list-messages-plugged): + Don't use elmo-msgdb-max-of-killed. It is harmful when messages are + killed not by synchronize (e.g. scoring). + +2003-07-22 Hiroya Murata + + * elmo.el (elmo-folder-search-fast): Return t if condition is not + treated. + (elmo-folder-search): Follow the change above. + + * elmo-util.el (elmo-read-search-condition-internal): Add `Flag' + into the candidates of search field. + +2003-07-21 Yuuichi Teranishi + + * elmo-msgdb.el (elmo-msgdb-set-flag): Overwrite answered flag. + (elmo-msgdb-unset-flag): Ditto. + + * elmo-imap4.el (elmo-imap4-fetch-callback-1-subr): Precedes Seen flag. + +2003-07-19 Yuuichi Teranishi + + * elmo-pipe.el (elmo-folder-msgdb-create): Don't define. + (elmo-folder-commit): Define. + (elmo-folder-synchronize): Ditto. + (elmo-folder-list-flagged): Ditto. + (elmo-folder-commit): Ditto. + (elmo-folder-length): Ditto. + (elmo-folder-count-flags): Ditto. + (elmo-message-mark): Ditto. + (elmo-message-field): Ditto. + (elmo-message-entity): Ditto. + (elmo-message-folder): Ditto. + +2003-07-18 Yuuichi Teranishi + + * elmo.el (elmo-message-field): Define as a method. + + * elmo-multi.el (elmo-message-entity): Fixed bug when no entity found. + (elmo-message-field): Define. + + * elmo.el (elmo-folder-list-unreads): Don't use msgdb API. + (elmo-folder-list-importants): Ditto. + (elmo-folder-list-answereds): Ditto. + + * elmo-multi.el (elmo-folder-mark-as-important): Remove :before + qualifier. + (elmo-folder-mark-as-read): Ditto. + (elmo-folder-unmark-read): Ditto. + (elmo-folder-mark-as-answered): Ditto. + (elmo-folder-unmark-answered): Ditto. + (elmo-folder-list-flagged): Define. + (elmo-folder-commit): Ditto. + (elmo-folder-length): Ditto. + (elmo-folder-count-flags): Ditto. + +2003-07-17 Yuuichi Teranishi + + * elmo.el (elmo-folder-detach-messages): New method. + (elmo-folder-move-messages): Use it. + (elmo-folder-synchronize): Ditto. + + * elmo-multi.el (elmo-folder-detach-messages): Define. + + * elmo.el (elmo-message-copy-entity): New function. + (elmo-message-entity-set-number): Ditto. + (elmo-message-mark): Define as method. + + * elmo-multi.el (elmo-multi-real-folder-number): Changed position. + (elmo-folder-synchronize): Return 0 (Should be reconsider). + (elmo-message-entity): Fixed last change. + (elmo-message-mark): Define. + (elmo-folder-msgdb-create): Abolish. + (elmo-multi-folder-append-msgdb): Ditto. + (elmo-multi-folder-diff): Fixed. + (elmo-multi-split-number-alist): Removed. + (elmo-multi-split-mark-alist): Removed. + (elmo-folder-list-messages): Define. + (elmo-folder-list-messages-internal): Removed. + + * elmo-localdir.el (elmo-folder-append-messages): Treat flags for + local file messages. + (elmo-folder-msgdb-create): Fixed read mark. + +2003-07-17 Hiroya Murata + + * elmo.el (elmo-generic-folder-append-messages): Set flag as nil + if mark is nil. + +2003-07-17 Yuuichi Teranishi + + * elmo.el (elmo-folder-list-message-entities): Define as inline + function. + (elmo-folder-messages): Abolish. + + * elmo-multi.el (elmo-folder-check): Call elmo-folder-check for each + folder. + (elmo-folder-synchronize): Define. + (elmo-message-entity): Define. + +2003-07-16 Yuuichi Teranishi + + * elmo-imap4.el (elmo-folder-delete-messages-plugged): Call + elmo-imap4-session-select-mailbox. + + * elmo.el (elmo-folder-move-messages): Don't display any message. + + * elmo-imap4.el (elmo-imap4-send-command): Accept process output when + parsing. + (elmo-imap4-session-check): Don't wait CHECK response. + (elmo-folder-delete-messages-plugged): Don't wait EXPUNGE response. + +2003-07-13 Yuuichi Teranishi + + * elmo.el (elmo-folder-synchronize): Fixed bug when sync-all. + 2003-07-12 Yuuichi Teranishi + * elmo-multi.el (elmo-folder-process-crosspost): Follow the change in + API. + * elmo-nntp.el (elmo-folder-process-crosspost): Ditto. + + + * elmo.el (elmo-folder-process-crosspost): Remove optional argument. + (elmo-folder-list-message-entities): Added argument in-msgdb and + numbers. + (elmo-folder-synchronize): Define as a method. + * elmo-nntp.el (elmo-folder-initialize): Don't use elmo-nntp-default-user if zero-length username is specified explicitly. @@ -52,6 +209,76 @@ * elmo-pipe.el (elmo-folder-clear): Implemented clear copied-list. +2003-04-05 Hiroya Murata + + * elmo-msgdb.el (elmo-msgdb-message-entity-field): Don't use self + recursive call (can't byte compile on emacs 20.7). + +2003-04-02 Yuuichi Teranishi + + * elmo.el (elmo-folder-list-messages): Redefine as a luna method. + (elmo-folder-list-message-entities): New API. + (elmo-message-entity): Ditto. + (elmo-message-entity-parent): Ditto. + (elmo-folder-do-each-message-entity): Ditto. + (elmo-message-entity-number): Ditto. + (elmo-message-entity-field): Ditto. + (elmo-message-entity-set-field): Ditto. + (elmo-folder-count-flags): Ditto. + (elmo-folder-length): Ditto. + + * elmo-util.el (elmo-get-hash-val): Check whether hashtable is nil or + not. + + * elmo-msgdb.el (elmo-msgdb-list-messages): New function. + (elmo-msgdb-count-marks): Abolish. + (elmo-msgdb-make-entity): Ditto. + (elmo-msgdb-do-each-entity): Ditto. + (elmo-msgdb-message-entity): New inline function. + (elmo-msgdb-message-entity-field): Ditto. + (elmo-msgdb-message-entity-set-field): Ditto. + (elmo-msgdb-make-message-entity): New function. + +2003-03-25 Yuuichi Teranishi + + * elmo.el (elmo-folder-append-buffer): Changed argument from unread + to flag. (All other related portions are changed.) + (elmo-folder-msgdb-create): Likewise. + (elmo-generic-folder-append-messages): Use flag-table instead of + seen-list. + (elmo-folder-move-messages): Removed redundant process. + (elmo-folder-synchronize): Likewise. + + * elmo-msgdb.el (elmo-flag-table-get): New function. + (elmo-flag-table-save): Fixed. + (elmo-msgdb-length): New inline function. + (elmo-msgdb-flag-table): New function. + (elmo-msgdb-mark): Add optional argument new. + (elmo-msgdb-add-msgs-to-seen-list): Abolish. + (elmo-msgdb-seen-list): Ditto. + (elmo-msgdb-add-msgs-to-seen-list): Ditto. + + +2003-03-24 Yuuichi Teranishi + + * elmo.el (elmo-message-set-mark): Abolish. + (elmo-folder-unmark-important): Added optional argument `ignore-flag'. + (All related portions are changed.) + + * elmo-msgdb.el (toplevel): Added comment. + (elmo-load-msgdb): Added 4th element `path'. + (elmo-msgdb-append): Follow the change above. + (elmo-msgdb-clear): Ditto. + (elmo-msgdb-delete-msgs): Ditto. + (elmo-msgdb-get-path): New inline function. + (elmo-msgdb-set-path): Ditto. + (elmo-flag-table-filename): New variable. + (elmo-flag-table-load): New function. + (elmo-flag-table-set): Ditto. + (elmo-flag-table-save): Ditto. + (elmo-msgdb-get-field-value): Abolish. + (elmo-msgdb-overview-get-entity-by-number): Ditto. + 2003-03-30 Yoichi NAKAYAMA * elmo.el (elmo-folder-delete): Confirm deletion here, return t if @@ -118,11 +345,6 @@ * elmo-localdir.el (elmo-folder-rename-internal): Referctoring; Replace nested conditional with guard clauses. -2003-01-30 TAKAHASHI Kaoru - - * elmo-archive.el (elmo-folder-rename-internal): Referctoring; - Replace nested conditional with guard clauses. - 2003-01-30 Yuuichi Teranishi * pldap.el (ldap-search-basic): Don't treat exit status 32 as an @@ -131,6 +353,11 @@ * elmo-imap4.el (elmo-folder-msgdb-create-plugged): Bind print-level, print-depth. +2003-01-30 TAKAHASHI Kaoru + + * elmo-archive.el (elmo-folder-rename-internal): Referctoring; + Replace nested conditional with guard clauses. + 2003-01-29 Yoichi NAKAYAMA * elmo-util.el (elmo-object-save): Bind print-level, print-length. @@ -268,14 +495,73 @@ * elmo-imap4.el: Remove Nemacs hack, replace `elmo-read' by `read'. * elmo-util.el: Ditto. +2002-10-28 Yuuichi Teranishi + + * elmo.el (elmo-message-accessible-p): Renamed from + elmo-message-cached-p and rewritten. + +2002-10-27 Yuuichi Teranishi + + * elmo.el (elmo-folder-list-flagged): New generic function. + (elmo-folder-list-importants): New implementation. + (elmo-folder-list-answereds): Ditto. + (elmo-folder-search-fast): Use 'flag' instead of 'mark'; + Added 'digest'. + (elmo-message-cached-p): New function. + (elmo-message-set-flag): Ditto (no content). + (elmo-message-unset-flag): Ditto. + (elmo-folder-list-messages-mark-match): Abolish. + + * elmo-util.el (elmo-regexp-opt): New function. + + * elmo-msgdb.el (elmo-msgdb-get-cached): New function. + (elmo-msgdb-match-condition-primitive): Use 'flag' instead of 'mark'; + Added 'digest'. + (elmo-msgdb-list-flagged): New function. + + * elmo-imap4.el (elmo-imap4-folder-list-digest-plugged): New function. + (elmo-imap4-search-internal-primitive): Use 'flag' instead of 'mark'; + Added 'digest'. + + * elmo-filter.el (elmo-folder-diff): Use 'flag' instead of 'mark'. + 2002-10-26 Yuuichi Teranishi * elmo-version.el (elmo-version): Up to 2.11.0. -2002-10-22 Yuuichi Teranishi +2002-10-24 Hiroya Murata + + * elmo-msgdb.el (elmo-msgdb-set-flag): Use + `elmo-file-cache-exists-p'; use proper mark that depends on + `use-cache'. + (elmo-msgdb-unset-flag): Ditto. + (elmo-msgdb-set-cached): Ditto. added argument `use-cache'. + + * elmo.el (elmo-message-set-cached): Call `elmo-msgdb-set-cached' + with 4th argument `use-cache'. + +2002-10-18 Yuuichi Teranishi + + * elmo.el (elmo-folder-unmark-important): Follow the changes above. + (elmo-folder-mark-as-important): Ditto. + (elmo-folder-unmark-read): Ditto. + (elmo-folder-mark-as-read): Ditto. + (elmo-folder-unmark-answered): Ditto. + (elmo-folder-mark-as-answered): Ditto. + + * elmo-msgdb.el (elmo-msgdb-set-cached): Use the term 'flag' for + message status. + (elmo-msgdb-mark): Likewise. + (elmo-msgdb-set-flag): Renamed from elmo-msgdb-set-status. + (elmo-msgdb-unset-flag): Likewise. * elmo.el (elmo-generic-folder-diff): Avoid byte-compile warning. +2002-10-15 Hiroya Murata + + * elmo-filter.el (elmo-folder-diff): Fixed condition checking + `last:' filter. + 2002-10-12 Yoichi NAKAYAMA * elmo-dop.el (elmo-folder-status-dop): If spool-folder is absent, @@ -286,16 +572,298 @@ * elmo-dop.el (elmo-dop-queue-flush): Check obsolete at first. (elmo-dop-queue-flush): Fixed last change. +2002-10-01 Hiroya Murata + + * elmo-filter.el (elmo-folder-list-unreads): Call generic method + if require-msgdb slot is nil. + (elmo-folder-list-importants): Likewise. + +2002-09-26 Hiroya Murata + + * elmo.el (elmo-message-set-cached): Set mark-modified slot if + mark is changed. + + * elmo-msgdb.el (elmo-msgdb-set-mark): Return t. + (elmo-msgdb-set-cached): Undo last change; return non-nil if mark + is changed. + +2002-09-25 Yuuichi Teranishi + + * elmo-msgdb.el (elmo-msgdb-set-cached): Set mark-modified slot. + +2002-09-24 Yuuichi Teranishi + + * elmo-msgdb.el (elmo-msgdb-unset-status): Set mark-modified slot. + + * elmo-multi.el (elmo-folder-close): Set msgdb of children as nil. + +2002-09-24 Hiroya Murata + + * elmo-msgdb.el (elmo-msgdb-set-status): Fixed logic (new to read). + (elmo-msgdb-uncached-marks): Added elmo-msgdb-new-mark. + 2002-09-24 Yoichi NAKAYAMA * elmo.el: Add autoload setting for elmo-nntp-post, fix against the problem reported by Sean Rima [wl-en:180]. +2002-09-19 Yuuichi Teranishi + + * elmo-filter.el (elmo-folder-diff): Treat 'mark:' filter. + + * elmo.el (elmo-folder-unmark-read): Added argument `ignore-flag'. + + * elmo-filter.el (elmo-folder-unmark-read): Ditto. + + * elmo-map.el (elmo-folder-unmark-read): Ditto. + + * elmo-multi.el (elmo-folder-unmark-read): Ditto. + + * elmo-net.el (elmo-folder-unmark-read): Ditto. + + * elmo-pipe.el (elmo-folder-unmark-read): Ditto. + 2002-09-18 Yuuichi Teranishi * elmo-imap4.el (elmo-imap4-parse-status): Skip white spaces after status number. +2002-09-17 Yuuichi Teranishi + + * elmo.el (elmo-folder-mark-as-read): Added argument `ignore-flag'. + (elmo-folder-mark-as-read): Follow the API change. + (elmo-message-set-cached): New function. + + * elmo-pipe.el (elmo-folder-mark-as-read): Follow the API change. + + * elmo-nntp.el (elmo-folder-mark-as-read): Set :before qualifier. + + * elmo-net.el (elmo-folder-unmark-important): Set :before qualifier. + (elmo-folder-mark-as-important): Ditto. + (elmo-folder-unmark-read): Ditto. + (elmo-folder-mark-as-read): Ditto. + (elmo-folder-unmark-answered): Ditto. + (elmo-folder-mark-as-answered): Ditto. + + * elmo-multi.el (elmo-folder-mark-as-important): Set :before qualifier. + (elmo-folder-unmark-important): Ditto. + (elmo-folder-mark-as-read): Ditto. + (elmo-folder-unmark-read): Ditto. + (elmo-folder-mark-as-answered): Ditto. + (elmo-folder-unmark-answered): Ditto. + + * elmo-mark.el (toplevel): Removed some mark method definitions. + + * elmo-map.el (elmo-map-folder-unmark-answered): New method. + (elmo-map-folder-mark-as-answered): Ditto. + (elmo-folder-unmark-important): Add :before qualifier. + (elmo-folder-mark-as-important): Ditto. + (elmo-folder-unmark-read): Ditto. + (elmo-folder-mark-as-read): Ditto. + (elmo-folder-unmark-answered): Define. + (elmo-folder-mark-as-answered): Ditto. + + * elmo-maildir.el (elmo-map-folder-mark-as-answered): Define. + (elmo-map-folder-unmark-answered): Ditto. + + * elmo-filter.el (elmo-folder-mark-as-read): Follow the API change. + + * elmo-net.el (elmo-folder-unmark-important): Added :around qualifier. + (elmo-folder-mark-as-important): Ditto. + (elmo-folder-unmark-read): Ditto. + (elmo-folder-mark-as-read): Ditto. + (elmo-folder-unmark-answered): Ditto. + (elmo-folder-mark-as-answered): Ditto. + + * elmo-msgdb.el (elmo-msgdb-match-condition-primitive): Added argument + `mark'; evaluate mark condition. + (elmo-msgdb-match-condition-internal): New function. + (elmo-msgdb-match-condition): Call it; changed argument. + + * elmo.el (elmo-folder-search): Follow the API change on + `elmo-msgdb-match-condition'. + +2002-09-17 Hiroya Murata + + * elmo-filter.el (elmo-folder-msgdb-create): Add to mark-alist if + original mark is non-nil. + +2002-09-17 Yuuichi Teranishi + + * elmo-map.el (elmo-map-folder-list-unreads): Define default behavior. + (elmo-map-folder-list-answereds): New method. + (elmo-folder-list-unreads): Add :around qualifier. + (elmo-folder-list-importants): Ditto. + (elmo-folder-list-answereds): Ditto. + +2002-09-16 Yuuichi Teranishi + + * elmo-msgdb.el (elmo-msgdb-mark): New inline function. + + * elmo-filter.el (elmo-folder-msgdb-create): Call target-folder's + method if msgdb is not required. + (elmo-filter-folder-list-importants): Don't treat global-mark. + + * elmo.el (elmo-folder-list-importants): Ditto. + + * elmo-net.el (elmo-folder-list-importants): Ditto. + + * elmo-map.el (elmo-folder-list-importants): Ditto. + + * elmo-msgdb.el (elmo-msgdb-seen-list): Use `elmo-msgdb-unread-marks' + + * elmo-imap4.el (elmo-imap4-fetch-callback-1-subr): Set answered mark. + (elmo-imap4-folder-list-any-plugged): New function. + (elmo-imap4-search-internal-primitive): Use it. + + * elmo-filter.el (elmo-folder-check): Synchronize original folder + only when require-msgdb slot is non-nil. + (elmo-folder-close): Clear target folder's msgdb. + +2002-09-13 Yuuichi Teranishi + + * elmo-pop3.el (elmo-folder-msgdb-create): Follow the API change. + (elmo-pop3-msgdb-create-by-header): Ditto. + (elmo-pop3-msgdb-create-message): Ditto. + + * elmo-shimbun.el (elmo-folder-msgdb-create): Ditto. + + * elmo-sendlog.el (elmo-folder-msgdb-create): Ditto. + + * elmo-nmz.el (elmo-folder-msgdb-create): Ditto. + + * elmo-nntp.el (elmo-nntp-create-msgdb-from-overview-string): Ditto. + (elmo-folder-msgdb-create): Ditto. + (elmo-nntp-folder-msgdb-create): Ditto. + (elmo-nntp-msgdb-create-by-header): Ditto. + (elmo-nntp-msgdb-create-message): Ditto. + (elmo-folder-list-unreads): Define. + + * elmo-pipe.el (elmo-folder-msgdb-create): Ditto. + (elmo-folder-append-messages): Ditto. + (elmo-folder-list-unreads): Define. + (elmo-folder-list-importants): Ditto. + (elmo-folder-list-answereds): Ditto. + + * elmo-net.el (elmo-folder-list-unreads): Define. + (elmo-folder-list-importants): Ditto. + (elmo-folder-list-answereds): Ditto. + (elmo-folder-list-answereds-plugged): Ditto. + (elmo-folder-msgdb-create): Follow the API change. + (elmo-folder-msgdb-create-unplugged): Ditto. + (elmo-folder-unmark-answered): Define. + (elmo-folder-mark-as-answered-unplugged): Ditto. + (elmo-folder-unmark-answered-unplugged): Ditto. + + * elmo-msgdb.el (elmo-msgdb-new-mark): New user option. + (elmo-msgdb-unread-uncached-mark): Ditto. + (elmo-msgdb-unread-cached-mark): Ditto. + (elmo-msgdb-read-uncached-mark): Ditto. + (elmo-msgdb-answered-cached-mark): Ditto. + (elmo-msgdb-answered-uncached-mark): Ditto. + (elmo-msgdb-important-mark): Ditto. + (elmo-msgdb-set-mark): Rewrite. + (elmo-msgdb-count-marks): Rewrite. + (elmo-msgdb-mark-alist-set): Abolish. + (elmo-msgdb-seen-list): Removed argument `seen-marks'. + (elmo-msgdb-add-msgs-to-seen-list): Likewise. + + * elmo-multi.el (elmo-folder-check): Call elmo-folder-synchronize. + (elmo-folder-close): Define. + (elmo-folder-msgdb-create): Follow the API change. + (elmo-folder-list-unreads): Rewrite. + (elmo-folder-mark-as-important): Ditto. + (elmo-folder-unmark-important): Ditto. + (elmo-folder-mark-as-read): Ditto. + (elmo-folder-unmark-read): Ditto. + (elmo-folder-mark-as-answered): Define. + (elmo-folder-unmark-answered): Ditto. + + * elmo-localdir.el (elmo-folder-msgdb-create): Follow the API change. + (elmo-folder-append-messages): Ditto. + + * elmo-mark.el (elmo-folder-msgdb-create): Ditto. + + * elmo-map.el (elmo-folder-list-unreads): Ditto. + (elmo-folder-list-importants): Ditto. + + * elmo-maildir.el (elmo-folder-msgdb-create): Ditto. + (elmo-folder-append-messages): Ditto. + + * elmo-imap4.el (elmo-imap4-fetch-callback-1-subr): Follow the API + change. + (elmo-folder-msgdb-create-plugged): Ditto. + (elmo-folder-append-messages): Ditto. + (elmo-folder-list-answereds-plugged): Define. + (elmo-imap4-search-internal-primitive): Add `mark' processing. + (elmo-folder-unmark-answered-plugged): Define. + (elmo-folder-mark-as-answered-plugged): Ditto. + (elmo-folder-search-requires-msgdb-p): Ditto. + + * elmo-filter.el (elmo-filter-folder): Added new slot 'require-msgdb'. + (elmo-folder-initialize): Set it. + (elmo-folder-msgdb): Define. + (elmo-folder-check): Call elmo-folder-synchronize. + (elmo-folder-close): Define. + (elmo-folder-commit): Ditto. + (elmo-folder-msgdb-create): Rewrite. + (elmo-folder-list-unreads): Ditto. + (elmo-folder-list-importants): Ditto. + (elmo-folder-mark-as-read): Ditto. + (elmo-folder-unmark-read): Ditto. + (elmo-folder-mark-as-important): Ditto. + (elmo-folder-unmark-important): Ditto. + (elmo-folder-mark-as-answered): Define. + (elmo-folder-unmark-answered): Ditto. + + * elmo-dop.el (elmo-dop-queue-merge-method-list): Added + elmo-folder-mark-as-answered, elmo-folder-unmark-answered. + (elmo-dop-queue-method-name-alist): Likewise. + (elmo-folder-mark-as-answered-dop): New inline function. + (elmo-folder-unmark-answered-dop): Ditto. + (elmo-folder-status-dop): Treat spool-length as 0 if it does not exist. + + * elmo-archive.el (elmo-folder-append-messages): Follow the API change. + (elmo-folder-msgdb-create): Ditto. + (elmo-archive-msgdb-create-as-numlist-subr1): Ditto. + (elmo-archive-msgdb-create-as-numlist-subr2): Ditto. + (elmo-archive-parse-mmdf): Ditto. + + * elmo-cache.el (elmo-folder-msgdb-create): Ditto. + (elmo-folder-list-unreads-internal): Ditto. + + * elmo.el (elmo-folder-msgdb): Define as generic function. + (elmo-folder-list-messages): Added argument `in-msgdb'. + (elmo-folder-list-unreads): Define as generic function. + (elmo-folder-list-importants): Ditto. + (elmo-folder-list-answereds): Ditto. + (elmo-folder-list-messages-with-global-mark): New function. + (elmo-folder-msgdb-create): Removed mark arguments. + (elmo-folder-unmark-answered): New generic function. + (elmo-folder-mark-as-answered): Ditto. + (elmo-folder-append-messages): Removed argunment `unread-marks' + (elmo-folder-list-unreads-internal): Abolish. + (elmo-folder-list-importants-internal): Ditto. + (elmo-folder-search-requires-msgdb-p): New generic function. + (elmo-folder-search-requires-msgdb-p-internal): New function. + (elmo-generic-folder-open): Call elmo-folder-msgdb instead of + elmo-msgdb-load. + (elmo-folder-search-fast): Added key 'mark'. + (elmo-generic-folder-append-messages): Use elmo-msgdb-unread-marks + instead of unread-marks argument. + (elmo-folder-move-messages): Removed argunment `unread-marks' + (elmo-folder-unmark-important): Define. + (elmo-folder-mark-as-important): Ditto. + (elmo-folder-unmark-read): Ditto. + (elmo-folder-mark-as-read): Ditto. + (elmo-folder-unmark-answered): Ditto. + (elmo-folder-mark-as-answered): Ditto. + (elmo-folder-replace-marks): Abolish. + (elmo-generic-folder-append-msgdb): Append msgdb before checking + duplicates. + (elmo-folder-synchronize): Removed mark arguments; + return crosspost only number. + 2002-09-12 Yoichi NAKAYAMA * elmo-dop.el (elmo-dop-queue-flush): Remove unused argument. diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index f76d026..2fb1c3c 100644 --- a/elmo/elmo-archive.el +++ b/elmo/elmo-archive.el @@ -578,11 +578,11 @@ TYPE specifies the archiver's symbol." (elmo-archive-message-fetch-internal folder number)) (luna-define-method elmo-folder-append-buffer ((folder elmo-archive-folder) - unread &optional number) - (elmo-archive-folder-append-buffer folder unread number)) + &optional flag number) + (elmo-archive-folder-append-buffer folder flag number)) ;; verrrrrry slow!! -(defun elmo-archive-folder-append-buffer (folder unread number) +(defun elmo-archive-folder-append-buffer (folder flag number) (let* ((type (elmo-archive-folder-archive-type-internal folder)) (prefix (elmo-archive-folder-archive-prefix-internal folder)) (arc (elmo-archive-get-archive-name folder)) @@ -621,8 +621,7 @@ TYPE specifies the archiver's symbol." nil)))))) (luna-define-method elmo-folder-append-messages :around - ((folder elmo-archive-folder) src-folder numbers unread-marks - &optional same-number) + ((folder elmo-archive-folder) src-folder numbers &optional same-number) (let ((prefix (elmo-archive-folder-archive-prefix-internal folder))) (cond ((and same-number @@ -915,9 +914,7 @@ TYPE specifies the archiver's symbol." (elmo-archive-msgdb-create-entity-subr number)))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-archive-folder) - numbers new-mark - already-mark seen-mark - important-mark seen-list) + numbers flag-table) (when numbers (save-excursion ;; 981005 (if (and elmo-archive-use-izip-agent @@ -925,17 +922,11 @@ TYPE specifies the archiver's symbol." (elmo-archive-folder-archive-type-internal folder) 'cat-headers)) (elmo-archive-msgdb-create-as-numlist-subr2 - folder numbers new-mark already-mark seen-mark important-mark - seen-list) + folder numbers flag-table) (elmo-archive-msgdb-create-as-numlist-subr1 - folder numbers new-mark already-mark seen-mark important-mark - seen-list))))) - -(defun elmo-archive-msgdb-create-as-numlist-subr1 (folder - numlist new-mark - already-mark seen-mark - important-mark - seen-list) + folder numbers flag-table))))) + +(defun elmo-archive-msgdb-create-as-numlist-subr1 (folder numlist flag-table) (let* ((type (elmo-archive-folder-archive-type-internal folder)) (file (elmo-archive-get-archive-name folder)) (method (elmo-archive-get-method type 'cat)) @@ -961,17 +952,13 @@ TYPE specifies the archiver's symbol." (elmo-msgdb-overview-entity-get-number entity) (car entity))) (setq message-id (car entity)) - (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - seen-mark - new-mark)))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist @@ -989,10 +976,8 @@ TYPE specifies the archiver's symbol." ;;; info-zip agent (defun elmo-archive-msgdb-create-as-numlist-subr2 (folder - numlist new-mark - already-mark seen-mark - important-mark - seen-list) + numlist + flag-table) (let* ((delim1 elmo-mmdf-delimiter) ;; MMDF (delim2 elmo-unixmail-delimiter) ;; UNIX Mail (type (elmo-archive-folder-archive-type-internal folder)) @@ -1025,10 +1010,7 @@ TYPE specifies the archiver's symbol." (goto-char (point-min)) (cond ((looking-at delim1) ;; MMDF - (setq result (elmo-archive-parse-mmdf msgs - new-mark - already-mark seen-mark - seen-list)) + (setq result (elmo-archive-parse-mmdf msgs flag-table)) (setq overview (append overview (nth 0 result))) (setq number-alist (append number-alist (nth 1 result))) (setq mark-alist (append mark-alist (nth 2 result)))) @@ -1047,13 +1029,10 @@ TYPE specifies the archiver's symbol." percent)))) (list overview number-alist mark-alist))) -(defun elmo-archive-parse-mmdf (msgs new-mark - already-mark - seen-mark - seen-list) +(defun elmo-archive-parse-mmdf (msgs flag-table) (let ((delim elmo-mmdf-delimiter) number sp ep rest entity overview number-alist mark-alist ret-val - message-id seen gmark) + message-id gmark) (goto-char (point-min)) (setq rest msgs) (while (and rest (re-search-forward delim nil t) @@ -1076,23 +1055,20 @@ TYPE specifies the archiver's symbol." (elmo-msgdb-overview-entity-get-number entity) (car entity))) (setq message-id (car entity)) - (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - seen-mark - new-mark)))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist (elmo-msgdb-overview-entity-get-number entity) gmark))) - (setq ret-val (append ret-val (list overview number-alist mark-alist))) + (setq ret-val (append ret-val (list overview number-alist + mark-alist))) (widen))) (forward-line 1) (setq rest (cdr rest))) diff --git a/elmo/elmo-cache.el b/elmo/elmo-cache.el index 67d80b7..84bcf3a 100644 --- a/elmo/elmo-cache.el +++ b/elmo/elmo-cache.el @@ -87,10 +87,7 @@ (elmo-cache-folder-directory-internal folder))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-cache-folder) - numbers new-mark - already-mark seen-mark - important-mark - seen-list) + numbers flag-table) (let ((i 0) (len (length numbers)) overview number-alist mark-alist entity message-id @@ -112,7 +109,11 @@ num message-id)) (if (setq mark (or (elmo-msgdb-global-mark-get message-id) - (if (member message-id seen-list) nil new-mark))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist @@ -127,8 +128,7 @@ (list overview number-alist mark-alist))) (luna-define-method elmo-folder-append-buffer ((folder elmo-cache-folder) - unread - &optional number) + &optional flag number) ;; dir-name is changed according to msgid. (unless (elmo-cache-folder-dir-name-internal folder) (let* ((file (elmo-file-cache-get-path (std11-field-body "message-id"))) @@ -170,27 +170,6 @@ (luna-define-method elmo-message-file-p ((folder elmo-cache-folder) number) t) -;;; To override elmo-map-folder methods. -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-cache-folder) unread-marks &optional mark-alist) - t) - -(luna-define-method elmo-folder-unmark-important ((folder elmo-cache-folder) - numbers) - t) - -(luna-define-method elmo-folder-mark-as-important ((folder elmo-cache-folder) - numbers) - t) - -(luna-define-method elmo-folder-unmark-read ((folder elmo-cache-folder) - numbers) - t) - -(luna-define-method elmo-folder-mark-as-read ((folder elmo-cache-folder) - numbers) - t) - (require 'product) (product-provide (provide 'elmo-cache) (require 'elmo-version)) diff --git a/elmo/elmo-dop.el b/elmo/elmo-dop.el index 666e91f..fda2f92 100644 --- a/elmo/elmo-dop.el +++ b/elmo/elmo-dop.el @@ -66,7 +66,9 @@ Automatically loaded/saved.") '(elmo-folder-mark-as-read elmo-folder-unmark-read elmo-folder-mark-as-important - elmo-folder-unmark-important)) + elmo-folder-unmark-important + elmo-folder-mark-as-answered + elmo-folder-unmark-answered)) (defvar elmo-dop-queue-method-name-alist '((elmo-folder-append-buffer-dop-delayed . "Append") @@ -75,6 +77,8 @@ Automatically loaded/saved.") (elmo-folder-create-dop-delayed . "Create") (elmo-folder-mark-as-read . "Read") (elmo-folder-unmark-read . "Unread") + (elmo-folder-mark-as-answered . "Answered") + (elmo-folder-unmark-answered . "Unanswered") (elmo-folder-mark-as-important . "Important") (elmo-folder-unmark-important . "Unimportant"))) @@ -230,10 +234,10 @@ FOLDER is the folder structure." (car (elmo-dop-queue-arguments queue))))))))) ;;; DOP operations. -(defsubst elmo-folder-append-buffer-dop (folder unread &optional number) +(defsubst elmo-folder-append-buffer-dop (folder &optional flag number) (elmo-dop-queue-append folder 'elmo-folder-append-buffer-dop-delayed - (list unread + (list flag (elmo-dop-spool-folder-append-buffer folder) number))) @@ -274,6 +278,12 @@ FOLDER is the folder structure." (defsubst elmo-folder-unmark-important-dop (folder numbers) (elmo-dop-queue-append folder 'elmo-folder-unmark-important (list numbers))) +(defsubst elmo-folder-mark-as-answered-dop (folder numbers) + (elmo-dop-queue-append folder 'elmo-folder-mark-as-answered (list numbers))) + +(defsubst elmo-folder-unmark-answered-dop (folder numbers) + (elmo-dop-queue-append folder 'elmo-folder-unmark-answered (list numbers))) + ;;; Execute as subsutitute for plugged operation. (defun elmo-folder-status-dop (folder) (let* ((number-alist (elmo-msgdb-number-load @@ -283,17 +293,15 @@ FOLDER is the folder structure." spool-length (i 0) max-num) - (setq spool-length - (or (car (if (elmo-folder-exists-p spool-folder) - (elmo-folder-status spool-folder))) - 0)) + (setq spool-length (or (car (if (elmo-folder-exists-p spool-folder) + (elmo-folder-status spool-folder))) 0)) (setq max-num (or (nth (max (- (length number-list) 1) 0) number-list) 0)) (cons (+ max-num spool-length) (+ (length number-list) spool-length)))) ;;; Delayed operation (executed at online status). -(defun elmo-folder-append-buffer-dop-delayed (folder unread number set-number) +(defun elmo-folder-append-buffer-dop-delayed (folder flag number set-number) (let ((spool-folder (elmo-dop-spool-folder folder)) failure saved dequeued) (with-temp-buffer @@ -303,14 +311,17 @@ FOLDER is the folder structure." (condition-case nil (setq failure (not (elmo-folder-append-buffer - folder unread set-number))) + folder + (if (eq flag t) nil flag) ; for compatibility + set-number))) (error (setq failure t))) (setq dequeued t)) ; Already deletef from queue. (when failure ;; Append failed... (setq saved (elmo-folder-append-buffer (elmo-make-folder elmo-lost+found-folder) - unread set-number))) + (if (eq flag t) nil flag) ; for compatibility + set-number))) (if (and (not dequeued) ; if dequeued, no need to delete. (or (not failure) ; succeed saved)) ; in lost+found diff --git a/elmo/elmo-filter.el b/elmo/elmo-filter.el index 11b4cbd..296efb9 100644 --- a/elmo/elmo-filter.el +++ b/elmo/elmo-filter.el @@ -33,7 +33,7 @@ ;;; ELMO filter folder (eval-and-compile (luna-define-class elmo-filter-folder (elmo-folder) - (condition target)) + (condition target require-msgdb)) (luna-define-internal-accessors 'elmo-filter-folder)) (luna-define-method elmo-folder-initialize ((folder elmo-filter-folder) @@ -47,17 +47,42 @@ folder (elmo-make-folder (elmo-match-string 1 (cdr pair)))) (error "Folder syntax error `%s'" (elmo-folder-name-internal folder))) + (elmo-filter-folder-set-require-msgdb-internal + folder + (elmo-folder-search-requires-msgdb-p + (elmo-filter-folder-target-internal folder) + (elmo-filter-folder-condition-internal folder))) folder)) (luna-define-method elmo-folder-open-internal ((folder elmo-filter-folder)) (elmo-folder-open-internal (elmo-filter-folder-target-internal folder))) +(luna-define-method elmo-folder-msgdb :around ((folder elmo-filter-folder)) + ;; Load target's msgdb if required. + (if (elmo-filter-folder-require-msgdb-internal folder) + (elmo-folder-msgdb (elmo-filter-folder-target-internal folder))) + ;; Load msgdb of itself. + (luna-call-next-method)) + (luna-define-method elmo-folder-check ((folder elmo-filter-folder)) - (elmo-folder-check (elmo-filter-folder-target-internal folder))) + (if (elmo-filter-folder-require-msgdb-internal folder) + (elmo-folder-synchronize (elmo-filter-folder-target-internal folder)))) (luna-define-method elmo-folder-close-internal ((folder elmo-filter-folder)) (elmo-folder-close-internal (elmo-filter-folder-target-internal folder))) +(luna-define-method elmo-folder-close :after ((folder elmo-filter-folder)) + ;; Clear target msgdb if it is used. + (if (elmo-filter-folder-require-msgdb-internal folder) + (elmo-folder-set-msgdb-internal (elmo-filter-folder-target-internal + folder) nil))) + +(luna-define-method elmo-folder-commit :around ((folder elmo-filter-folder)) + ;; Save target msgdb if it is used. + (if (elmo-filter-folder-require-msgdb-internal folder) + (elmo-folder-commit (elmo-filter-folder-target-internal folder))) + (luna-call-next-method)) + (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-filter-folder)) (expand-file-name @@ -84,57 +109,42 @@ type)) (luna-define-method elmo-folder-msgdb-create ((folder elmo-filter-folder) - numlist new-mark already-mark - seen-mark important-mark - seen-list) - (let ((target-folder (elmo-filter-folder-target-internal folder))) - (if (elmo-folder-plugged-p target-folder) - (elmo-folder-msgdb-create target-folder - numlist - new-mark - already-mark - seen-mark important-mark seen-list) - ;; Copy from msgdb of target folder if it is unplugged. - (let ((len (length numlist)) - (msgdb (elmo-folder-msgdb target-folder)) - overview number-alist mark-alist - message-id seen gmark) + numlist flag-table) + (if (elmo-filter-folder-require-msgdb-internal folder) + (let* ((target-folder (elmo-filter-folder-target-internal folder)) + (len (length numlist)) + (msgdb (elmo-folder-msgdb target-folder)) + overview number-alist mark-alist message-id entity mark) (when (> len elmo-display-progress-threshold) (elmo-progress-set 'elmo-folder-msgdb-create len "Creating msgdb...")) (unwind-protect (dolist (number numlist) - (let ((entity (elmo-msgdb-overview-get-entity number msgdb))) - (when entity - (setq entity (elmo-msgdb-copy-overview-entity entity) - overview (elmo-msgdb-append-element overview entity) - message-id (elmo-msgdb-overview-entity-get-id entity) - number-alist (elmo-msgdb-number-add number-alist - number - message-id) - seen (member message-id seen-list)) - (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-exists-p message-id) - (if seen - nil - already-mark) - (if seen - nil ;;seen-mark - new-mark)))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist - number - gmark))))) + (setq entity (elmo-msgdb-overview-get-entity number msgdb)) + (when entity + (setq overview (elmo-msgdb-append-element overview entity) + message-id (elmo-msgdb-overview-entity-get-id entity) + number-alist (elmo-msgdb-number-add number-alist + number + message-id)) + (when (setq mark (elmo-msgdb-get-mark msgdb number)) + (setq mark-alist (elmo-msgdb-mark-append + mark-alist + number + mark)))) (elmo-progress-notify 'elmo-folder-msgdb-create)) (elmo-progress-clear 'elmo-folder-msgdb-create)) - (list overview number-alist mark-alist))))) + (list overview number-alist mark-alist)) + ;; Does not require msgdb. + (elmo-folder-msgdb-create + (elmo-filter-folder-target-internal folder) + numlist flag-table))) (luna-define-method elmo-folder-append-buffer ((folder elmo-filter-folder) - unread &optional number) + &optional flag number) (elmo-folder-append-buffer (elmo-filter-folder-target-internal folder) - unread number)) + flag number)) (luna-define-method elmo-message-fetch ((folder elmo-filter-folder) number strategy @@ -160,48 +170,29 @@ ;; not available t))) -(defsubst elmo-filter-folder-list-unreads-internal (folder unread-marks - mark-alist) - (let ((unreads (elmo-folder-list-unreads-internal - (elmo-filter-folder-target-internal folder) - unread-marks - (or mark-alist - (elmo-msgdb-get-mark-alist - (elmo-folder-msgdb folder)))))) - (unless (listp unreads) - (setq unreads - (delq nil - (mapcar - (function - (lambda (x) - (if (member (cadr x) unread-marks) - (car x)))) - (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))))) - (elmo-list-filter - (mapcar 'car (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder))) - unreads))) - -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-filter-folder) - unread-marks &optional mark-alist) - (elmo-filter-folder-list-unreads-internal folder unread-marks mark-alist)) - -(defsubst elmo-filter-folder-list-importants-internal (folder important-mark) - (let ((importants (elmo-folder-list-importants-internal - (elmo-filter-folder-target-internal folder) - important-mark))) - (if (listp importants) - (elmo-list-filter - (mapcar 'car (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder))) - importants) - t))) +(defsubst elmo-filter-folder-list-unreads (folder) + (elmo-list-filter + (elmo-folder-list-messages folder nil 'in-msgdb) + (elmo-folder-list-unreads + (elmo-filter-folder-target-internal folder)))) + +(luna-define-method elmo-folder-list-unreads :around ((folder + elmo-filter-folder)) + (if (elmo-filter-folder-require-msgdb-internal folder) + (elmo-filter-folder-list-unreads folder) + (luna-call-next-method))) -(luna-define-method elmo-folder-list-importants-internal - ((folder elmo-filter-folder) - important-mark) - (elmo-filter-folder-list-importants-internal folder important-mark)) +(defsubst elmo-filter-folder-list-importants (folder) + (elmo-list-filter + (elmo-folder-list-messages folder nil 'in-msgdb) + (elmo-folder-list-importants + (elmo-filter-folder-target-internal folder)))) + +(luna-define-method elmo-folder-list-importants :around ((folder + elmo-filter-folder)) + (if (elmo-filter-folder-require-msgdb-internal folder) + (elmo-filter-folder-list-importants folder) + (luna-call-next-method))) (luna-define-method elmo-folder-list-subfolders ((folder elmo-filter-folder) &optional one-level) @@ -221,15 +212,25 @@ (luna-define-method elmo-folder-diff :around ((folder elmo-filter-folder) &optional numbers) - (if (not (and (vectorp (elmo-filter-folder-condition-internal - folder)) - (string-match "^last$" - (elmo-filter-key - (elmo-filter-folder-condition-internal - folder))))) - (cons nil (cdr (elmo-folder-diff (elmo-filter-folder-target-internal - folder)))) - (luna-call-next-method))) + (let ((condition (elmo-filter-folder-condition-internal folder)) + diff) + (if (vectorp condition) + (cond + ((and (string= (elmo-filter-key condition) "flag") + (or (string= (elmo-filter-value condition) "any") + (string= (elmo-filter-value condition) "digest") + (string= (elmo-filter-value condition) "unread"))) + (setq diff (elmo-folder-diff (elmo-filter-folder-target-internal + folder))) + (if (consp diff) + (cons (car diff) (car diff)) + (cons (car diff) (nth 1 diff)))) + ((string= "last" (elmo-filter-key condition)) + (luna-call-next-method)) + (t + (cons nil (cdr (elmo-folder-diff (elmo-filter-folder-target-internal + folder)))))) + (luna-call-next-method)))) (luna-define-method elmo-folder-status ((folder elmo-filter-folder)) (elmo-folder-status @@ -277,26 +278,54 @@ (elmo-message-file-name (elmo-filter-folder-target-internal folder) number)) -(luna-define-method elmo-folder-mark-as-read ((folder elmo-filter-folder) - numbers) +(luna-define-method elmo-folder-mark-as-read :around ((folder + elmo-filter-folder) + numbers + &optional ignore-flag) (elmo-folder-mark-as-read (elmo-filter-folder-target-internal folder) - numbers)) + numbers ignore-flag) + (luna-call-next-method)) -(luna-define-method elmo-folder-unmark-read ((folder elmo-filter-folder) - numbers) +(luna-define-method elmo-folder-unmark-read :around ((folder + elmo-filter-folder) + numbers + &optional ignore-flag) (elmo-folder-unmark-read (elmo-filter-folder-target-internal folder) - numbers)) - -(luna-define-method elmo-folder-mark-as-important ((folder elmo-filter-folder) - numbers) + numbers ignore-flag) + (luna-call-next-method)) + +(luna-define-method elmo-folder-mark-as-important :around ((folder + elmo-filter-folder) + numbers + &optional + ignore-flag) (elmo-folder-mark-as-important (elmo-filter-folder-target-internal folder) - numbers)) - -(luna-define-method elmo-folder-unmark-important ((folder elmo-filter-folder) - numbers) + numbers ignore-flag) + (luna-call-next-method)) + +(luna-define-method elmo-folder-unmark-important :around ((folder + elmo-filter-folder) + numbers + &optional + ignore-flag) (elmo-folder-unmark-important (elmo-filter-folder-target-internal folder) - numbers)) - + numbers ignore-flag) + (luna-call-next-method)) + +(luna-define-method elmo-folder-mark-as-answered :around ((folder + elmo-filter-folder) + numbers) + (elmo-folder-mark-as-answered (elmo-filter-folder-target-internal folder) + numbers) + (luna-call-next-method)) + + +(luna-define-method elmo-folder-unmark-answered :around ((folder + elmo-filter-folder) + numbers) + (elmo-folder-unmark-answered (elmo-filter-folder-target-internal folder) + numbers) + (luna-call-next-method)) (require 'product) (product-provide (provide 'elmo-filter) (require 'elmo-version)) diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index 47b4668..3ab05a3 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -291,8 +291,11 @@ Returns a TAG string which is assigned to the COMMAND." (when (elmo-imap4-response-bye-p elmo-imap4-current-response) (elmo-imap4-process-bye session)) (setq elmo-imap4-current-response nil) - (if elmo-imap4-parsing - (error "IMAP process is running. Please wait (or plug again)")) + (when elmo-imap4-parsing + (message "Waiting for IMAP response...") + (accept-process-output (elmo-network-session-process-internal + session)) + (message "Waiting for IMAP response...done")) (setq elmo-imap4-parsing t) (elmo-imap4-debug "<-(%s)- %s" tag command) (while (setq token (car command-args)) @@ -474,7 +477,7 @@ If response is not `OK' response, causes error with IMAP response text." (with-current-buffer (elmo-network-session-buffer session) (setq elmo-imap4-fetch-callback nil) (setq elmo-imap4-fetch-callback-data nil)) - (elmo-imap4-send-command-wait session "check")) + (elmo-imap4-send-command session "check")) (defun elmo-imap4-atom-p (string) "Return t if STRING is an atom defined in rfc2060." @@ -770,18 +773,15 @@ If CHOP-LENGTH is not specified, message set is not chopped." ;; ;; app-data: -;; cons of list -;; 0: new-mark 1: already-mark 2: seen-mark 3: important-mark -;; 4: seen-list -;; and result of use-flag-p. +;; cons of flag-table and result of use-flag-p. (defsubst elmo-imap4-fetch-callback-1-subr (entity flags app-data) "A msgdb entity callback function." (let* ((use-flag (cdr app-data)) (app-data (car app-data)) - (seen (member (car entity) (nth 4 app-data))) mark) (if (elmo-string-member-ignore-case "\\Flagged" flags) - (elmo-msgdb-global-mark-set (car entity) (nth 3 app-data))) + (elmo-msgdb-global-mark-set (car entity) + elmo-msgdb-important-mark)) (if (setq mark (elmo-msgdb-global-mark-get (car entity))) (unless (elmo-string-member-ignore-case "\\Seen" flags) (setq elmo-imap4-seen-messages @@ -790,17 +790,25 @@ If CHOP-LENGTH is not specified, message set is not chopped." elmo-imap4-seen-messages))) (setq mark (or (if (elmo-file-cache-status (elmo-file-cache-get (car entity))) - (if (or seen - (and use-flag - (elmo-string-member-ignore-case "\\Seen" flags))) - nil - (nth 1 app-data)) - (if (or seen - (and use-flag - (elmo-string-member-ignore-case "\\Seen" flags))) - (if elmo-imap4-use-cache - (nth 2 app-data)) - (nth 0 app-data)))))) + ;; cached. + (if (and use-flag (member "\\Seen" flags)) + (if (elmo-string-member-ignore-case + "\\Answered" flags) + elmo-msgdb-answered-cached-mark + nil) + elmo-msgdb-unread-cached-mark) + ;; uncached. + (if (elmo-string-member-ignore-case "\\Answered" flags) + elmo-msgdb-answered-uncached-mark + (if (and use-flag + (elmo-string-member-ignore-case + "\\Seen" flags)) + (if (elmo-string-member-ignore-case + "\\Answered" flags) + elmo-msgdb-answered-uncached-mark + (if elmo-imap4-use-cache + elmo-msgdb-read-uncached-mark)) + elmo-msgdb-new-mark)))))) (setq elmo-imap4-current-msgdb (elmo-msgdb-append elmo-imap4-current-msgdb @@ -1845,13 +1853,17 @@ Return nil if no complete line has arrived." (luna-define-method elmo-folder-list-messages-plugged ((folder elmo-imap4-folder) - &optional nohide) + &optional + enable-killed) (elmo-imap4-list folder - (let ((max (elmo-msgdb-max-of-killed - (elmo-folder-killed-list-internal folder)))) - (if (or nohide - (null (eq max 0))) - (format "uid %d:*" (1+ max)) + (let ((killed + (elmo-folder-killed-list-internal + folder))) + (if (and killed + (eq (length killed) 1) + (consp (car killed)) + (eq (car (car killed)) 1)) + (format "uid %d:*" (cdr (car killed))) "all")))) (luna-define-method elmo-folder-list-unreads-plugged @@ -1862,6 +1874,16 @@ Return nil if no complete line has arrived." ((folder elmo-imap4-folder)) (elmo-imap4-list folder "flagged")) +(luna-define-method elmo-folder-list-answereds-plugged + ((folder elmo-imap4-folder)) + (elmo-imap4-list folder "answered")) + +(defun elmo-imap4-folder-list-any-plugged (folder) + (elmo-imap4-list folder "or answered or unseen flagged")) + +(defun elmo-imap4-folder-list-digest-plugged (folder) + (elmo-imap4-list folder "or unseen flagged")) + (luna-define-method elmo-folder-use-flag-p ((folder elmo-imap4-folder)) (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp (elmo-imap4-folder-mailbox-internal folder)))) @@ -2072,8 +2094,12 @@ If optional argument REMOVE is non-nil, remove FLAG." (luna-define-method elmo-folder-delete-messages-plugged ((folder elmo-imap4-folder) numbers) (let ((session (elmo-imap4-get-session folder))) - (elmo-imap4-set-flag folder numbers "\\Deleted") - (elmo-imap4-send-command-wait session "expunge"))) + (elmo-imap4-session-select-mailbox + session + (elmo-imap4-folder-mailbox-internal folder)) + (unless (elmo-imap4-set-flag folder numbers "\\Deleted") + (error "Failed to set deleted flag")) + (elmo-imap4-send-command session "expunge"))) (defmacro elmo-imap4-detect-search-charset (string) (` (with-temp-buffer @@ -2083,7 +2109,7 @@ If optional argument REMOVE is non-nil, remove FLAG." (defun elmo-imap4-search-internal-primitive (folder session filter from-msgs) (let ((search-key (elmo-filter-key filter)) (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to" - "larger" "smaller")) + "larger" "smaller" "mark")) (total 0) (length (length from-msgs)) charset set-list end results) @@ -2101,6 +2127,18 @@ If optional argument REMOVE is non-nil, remove FLAG." numbers))) (mapcar '(lambda (x) (delete x numbers)) rest) numbers)) + ((string= "flag" search-key) + (cond + ((string= "unread" (elmo-filter-value filter)) + (elmo-folder-list-unreads folder)) + ((string= "important" (elmo-filter-value filter)) + (elmo-folder-list-importants folder)) + ((string= "answered" (elmo-filter-value filter)) + (elmo-folder-list-answereds folder)) + ((string= "digest" (elmo-filter-value filter)) + (elmo-imap4-folder-list-digest-plugged folder)) + ((string= "any" (elmo-filter-value filter)) + (elmo-imap4-folder-list-any-plugged folder)))) ((or (string= "since" search-key) (string= "before" search-key)) (setq search-key (concat "sent" search-key) @@ -2228,7 +2266,7 @@ If optional argument REMOVE is non-nil, remove FLAG." (luna-call-next-method))) (luna-define-method elmo-folder-msgdb-create-plugged - ((folder elmo-imap4-folder) numbers &rest args) + ((folder elmo-imap4-folder) numbers flag-table) (when numbers (let ((session (elmo-imap4-get-session folder)) (headers @@ -2254,7 +2292,7 @@ If optional argument REMOVE is non-nil, remove FLAG." (setq elmo-imap4-current-msgdb nil elmo-imap4-seen-messages nil elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1 - elmo-imap4-fetch-callback-data (cons args + elmo-imap4-fetch-callback-data (cons flag-table (elmo-folder-use-flag-p folder))) (while set-list @@ -2294,6 +2332,14 @@ If optional argument REMOVE is non-nil, remove FLAG." ((folder elmo-imap4-folder) numbers) (elmo-imap4-set-flag folder numbers "\\Seen")) +(luna-define-method elmo-folder-unmark-answered-plugged + ((folder elmo-imap4-folder) numbers) + (elmo-imap4-set-flag folder numbers "\\Answered" 'remove)) + +(luna-define-method elmo-folder-mark-as-answered-plugged + ((folder elmo-imap4-folder) numbers) + (elmo-imap4-set-flag folder numbers "\\Answered")) + (luna-define-method elmo-message-use-cache-p ((folder elmo-imap4-folder) number) elmo-imap4-use-cache) @@ -2319,7 +2365,7 @@ If optional argument REMOVE is non-nil, remove FLAG." (defsubst elmo-imap4-folder-diff-plugged (folder) (let ((session (elmo-imap4-get-session folder)) - messages new unread response killed) + messages new unread response killed uidnext) ;;; (elmo-imap4-commit spec) (with-current-buffer (elmo-network-session-buffer session) (setq elmo-imap4-status-callback nil) @@ -2331,14 +2377,18 @@ If optional argument REMOVE is non-nil, remove FLAG." (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal folder)) - " (recent unseen messages)"))) + " (recent unseen messages uidnext)"))) (setq response (elmo-imap4-response-value response 'status)) (setq messages (elmo-imap4-response-value response 'messages)) + (setq uidnext (elmo-imap4-response-value response 'uidnext)) (setq killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))) - (if killed - (setq messages (- messages - (elmo-msgdb-killed-list-length - killed)))) + ;; + (when killed + (when (and (consp (car killed)) + (eq (car (car killed)) 1)) + (setq messages (- uidnext (cdr (car killed)) 1))) + (setq messages (- messages + (elmo-msgdb-killed-list-length (cdr killed))))) (setq new (elmo-imap4-response-value response 'recent) unread (elmo-imap4-response-value response 'unseen)) (if (< unread new) (setq new unread)) @@ -2466,7 +2516,7 @@ If optional argument REMOVE is non-nil, remove FLAG." (elmo-imap4-folder-mailbox-internal folder))))) (luna-define-method elmo-folder-append-buffer - ((folder elmo-imap4-folder) unread &optional number) + ((folder elmo-imap4-folder) &optional flag number) (if (elmo-folder-plugged-p folder) (let ((session (elmo-imap4-get-session folder)) send-buffer result) @@ -2482,13 +2532,16 @@ If optional argument REMOVE is non-nil, remove FLAG." "append " (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal folder)) - (if unread " () " " (\\Seen) ") + (cond + ((eq flag 'read) " (\\Seen) ") + ((eq flag 'answered) " (\\Answered)") + (t " () ")) (elmo-imap4-buffer-literal send-buffer)))) (kill-buffer send-buffer)) result) ;; Unplugged (if elmo-enable-disconnected-operation - (elmo-folder-append-buffer-dop folder unread number) + (elmo-folder-append-buffer-dop folder flag number) (error "Unplugged")))) (eval-when-compile @@ -2502,8 +2555,7 @@ If optional argument REMOVE is non-nil, remove FLAG." (elmo-net-folder-user-internal (, folder2))))))) (luna-define-method elmo-folder-append-messages :around - ((folder elmo-imap4-folder) src-folder numbers unread-marks - &optional same-number) + ((folder elmo-imap4-folder) src-folder numbers &optional same-number) (if (and (eq (elmo-folder-type-internal src-folder) 'imap4) (elmo-imap4-identical-system-p folder src-folder) (elmo-folder-plugged-p folder)) @@ -2594,7 +2646,10 @@ If optional argument REMOVE is non-nil, remove FLAG." (goto-char (point-min)) (std11-field-body (symbol-name field))))) - +(luna-define-method elmo-folder-search-requires-msgdb-p ((folder + elmo-imap4-folder) + condition) + nil) (require 'product) (product-provide (provide 'elmo-imap4) (require 'elmo-version)) diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el index 176b4ef..4ed3d22 100644 --- a/elmo/elmo-localdir.el +++ b/elmo/elmo-localdir.el @@ -144,15 +144,11 @@ (luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder) numbers - new-mark - already-mark - seen-mark - important-mark - seen-list) + flag-table) (when numbers (let ((dir (elmo-localdir-folder-directory-internal folder)) overview number-alist mark-alist entity message-id - num seen gmark + num gmark (i 0) (len (length numbers))) (message "Creating msgdb...") @@ -171,15 +167,14 @@ (elmo-msgdb-number-add number-alist num message-id)) - (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-exists-p message-id) ; XXX - (if seen - nil - already-mark) - (if seen - nil ;;seen-mark - new-mark)))) + (unless (eq 'read (elmo-flag-table-get + flag-table message-id)) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new)))) (setq mark-alist (elmo-msgdb-mark-append mark-alist @@ -231,18 +226,32 @@ (luna-define-method elmo-folder-append-messages :around ((folder elmo-localdir-folder) - src-folder numbers unread-marks &optional same-number) + src-folder numbers &optional same-number) (if (elmo-folder-message-file-p src-folder) (let ((dir (elmo-localdir-folder-directory-internal folder)) + (table (elmo-flag-table-load (elmo-folder-msgdb-path folder))) (succeeds numbers) - (next-num (1+ (car (elmo-folder-status folder))))) + (next-num (1+ (car (elmo-folder-status folder)))) + mark flag id) (while numbers + (setq mark (elmo-message-mark src-folder (car numbers)) + flag (cond + ((null mark) nil) + ((member mark (elmo-msgdb-answered-marks)) + 'answered) + ;; + ((not (member mark (elmo-msgdb-unread-marks))) + 'read))) (elmo-copy-file (elmo-message-file-name src-folder (car numbers)) (expand-file-name (int-to-string (if same-number (car numbers) next-num)) dir)) + ;; src folder's msgdb is loaded. + (when (setq id (elmo-message-field src-folder (car numbers) + 'message-id)) + (elmo-flag-table-set table id flag)) (elmo-progress-notify 'elmo-folder-move-messages) (if (and (setq numbers (cdr numbers)) (not same-number)) @@ -251,6 +260,8 @@ ;; MDA is running. (1+ (car (elmo-folder-status folder))) (1+ next-num))))) + (when (elmo-folder-persistent-p folder) + (elmo-flag-table-save (elmo-folder-msgdb-path folder) table)) succeeds) (luna-call-next-method))) diff --git a/elmo/elmo-maildir.el b/elmo/elmo-maildir.el index 286c274..151a232 100644 --- a/elmo/elmo-maildir.el +++ b/elmo/elmo-maildir.el @@ -132,8 +132,7 @@ LOCATION." (elmo-maildir-folder-flagged-locations-internal folder)) (luna-define-method elmo-folder-msgdb-create - ((folder elmo-maildir-folder) - numbers new-mark already-mark seen-mark important-mark seen-list) + ((folder elmo-maildir-folder) numbers flag-table) (let* ((unread-list (elmo-maildir-folder-unread-locations-internal folder)) (flagged-list (elmo-maildir-folder-flagged-locations-internal folder)) (len (length numbers)) @@ -159,9 +158,9 @@ LOCATION." entity))) (cond ((member location unread-list) - (setq mark new-mark)) ; unread! + (setq mark elmo-msgdb-new-mark)) ; unread! ((member location flagged-list) - (setq mark important-mark))) + (setq mark elmo-msgdb-important-mark))) (if (setq mark (or (elmo-msgdb-global-mark-get (elmo-msgdb-overview-entity-get-id entity)) @@ -278,6 +277,16 @@ LOCATION." locs) (elmo-maildir-delete-mark-msgs folder locs ?S)) +(luna-define-method elmo-map-folder-mark-as-answered ((folder + elmo-maildir-folder) + locs) + (elmo-maildir-set-mark-msgs folder locs ?R)) + +(luna-define-method elmo-map-folder-unmark-answered ((folder + elmo-maildir-folder) + locs) + (elmo-maildir-delete-mark-msgs folder locs ?R)) + (luna-define-method elmo-folder-list-subfolders ((folder elmo-maildir-folder) &optional one-level) (let ((prefix (concat (elmo-folder-name-internal folder) @@ -345,7 +354,7 @@ file name for maildir directories." filename)) (luna-define-method elmo-folder-append-buffer ((folder elmo-maildir-folder) - unread &optional number) + &optional status number) (let ((basedir (elmo-maildir-folder-directory-internal folder)) (src-buf (current-buffer)) dst-buf filename) @@ -397,7 +406,7 @@ file name for maildir directories." (luna-define-method elmo-folder-append-messages :around ((folder elmo-maildir-folder) - src-folder numbers unread-marks &optional same-number) + src-folder numbers &optional same-number) (if (elmo-folder-message-file-p src-folder) (let ((dir (elmo-maildir-folder-directory-internal folder)) (succeeds numbers) diff --git a/elmo/elmo-map.el b/elmo/elmo-map.el index 2a96abc..2657ea5 100644 --- a/elmo/elmo-map.el +++ b/elmo/elmo-map.el @@ -74,6 +74,12 @@ (luna-define-generic elmo-map-folder-mark-as-read (folder locations) "") +(luna-define-generic elmo-map-folder-unmark-answered (folder locations) + "") + +(luna-define-generic elmo-map-folder-mark-as-answered (folder locations) + "") + (luna-define-generic elmo-map-message-fetch (folder location strategy &optional @@ -84,12 +90,21 @@ (luna-define-generic elmo-map-folder-list-unreads (folder) "") +(luna-define-method elmo-map-folder-list-unreads ((folder elmo-map-folder)) + t) + (luna-define-generic elmo-map-folder-list-importants (folder) "") (luna-define-method elmo-map-folder-list-importants ((folder elmo-map-folder)) t) +(luna-define-generic elmo-map-folder-list-answereds (folder) + "") + +(luna-define-method elmo-map-folder-list-answereds ((folder elmo-map-folder)) + t) + (luna-define-generic elmo-map-folder-delete-messages (folder locations) "") @@ -260,26 +275,54 @@ ((folder elmo-map-folder) &optional nohide) (mapcar 'car (elmo-map-folder-location-alist-internal folder))) -(luna-define-method elmo-folder-unmark-important ((folder elmo-map-folder) - numbers) - (elmo-map-folder-unmark-important - folder - (elmo-map-folder-numbers-to-locations folder numbers))) +(luna-define-method elmo-folder-unmark-important :before ((folder + elmo-map-folder) + numbers + &optional + ignore-flags) + (unless ignore-flags + (elmo-map-folder-unmark-important + folder + (elmo-map-folder-numbers-to-locations folder numbers)))) + +(luna-define-method elmo-folder-mark-as-important :before ((folder + elmo-map-folder) + numbers + &optional + ignore-flags) + (unless ignore-flags + (elmo-map-folder-mark-as-important + folder + (elmo-map-folder-numbers-to-locations folder numbers)))) -(luna-define-method elmo-folder-mark-as-important ((folder elmo-map-folder) - numbers) - (elmo-map-folder-mark-as-important - folder - (elmo-map-folder-numbers-to-locations folder numbers))) +(luna-define-method elmo-folder-unmark-read :before ((folder elmo-map-folder) + numbers + &optional ignore-flags) + (unless ignore-flags + (elmo-map-folder-unmark-read + folder + (elmo-map-folder-numbers-to-locations folder numbers)))) + +(luna-define-method elmo-folder-mark-as-read :before ((folder + elmo-map-folder) + numbers + &optional ignore-flags) + (unless ignore-flags + (elmo-map-folder-mark-as-read + folder + (elmo-map-folder-numbers-to-locations folder numbers)))) -(luna-define-method elmo-folder-unmark-read ((folder elmo-map-folder) - numbers) - (elmo-map-folder-unmark-read +(luna-define-method elmo-folder-unmark-answered :before ((folder + elmo-map-folder) + numbers) + (elmo-map-folder-unmark-answered folder (elmo-map-folder-numbers-to-locations folder numbers))) -(luna-define-method elmo-folder-mark-as-read ((folder elmo-map-folder) numbers) - (elmo-map-folder-mark-as-read +(luna-define-method elmo-folder-mark-as-answered :before ((folder + elmo-map-folder) + numbers) + (elmo-map-folder-mark-as-answered folder (elmo-map-folder-numbers-to-locations folder numbers))) @@ -291,18 +334,25 @@ (elmo-map-message-location folder number) strategy section unread)) -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-map-folder) unread-marks &optional mark-alist) - (elmo-map-folder-locations-to-numbers - folder - (elmo-map-folder-list-unreads folder))) +(luna-define-method elmo-folder-list-unreads :around ((folder elmo-map-folder)) + (let ((locations (elmo-map-folder-list-unreads folder))) + (if (listp locations) + (elmo-map-folder-locations-to-numbers folder locations) + (luna-call-next-method)))) -(luna-define-method elmo-folder-list-importants-internal - ((folder elmo-map-folder) important-mark) +(luna-define-method elmo-folder-list-importants :around ((folder + elmo-map-folder)) (let ((locations (elmo-map-folder-list-importants folder))) (if (listp locations) (elmo-map-folder-locations-to-numbers folder locations) - t))) + (luna-call-next-method)))) + +(luna-define-method elmo-folder-list-answereds :around ((folder + elmo-map-folder)) + (let ((locations (elmo-map-folder-list-answereds folder))) + (if (listp locations) + (elmo-map-folder-locations-to-numbers folder locations) + (luna-call-next-method)))) (luna-define-method elmo-folder-delete-messages ((folder elmo-map-folder) numbers) @@ -318,7 +368,6 @@ folder)) (elmo-map-folder-location-alist-internal folder)))) t) ; success - (require 'product) (product-provide (provide 'elmo-map) (require 'elmo-version)) diff --git a/elmo/elmo-mark.el b/elmo/elmo-mark.el index 02cdde2..8773739 100644 --- a/elmo/elmo-mark.el +++ b/elmo/elmo-mark.el @@ -84,15 +84,10 @@ (elmo-map-message-location folder number))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-mark-folder) - numbers new-mark - already-mark seen-mark - important-mark - seen-list) - (elmo-mark-folder-msgdb-create folder numbers new-mark already-mark - seen-mark important-mark)) - -(defun elmo-mark-folder-msgdb-create (folder numbers new-mark already-mark - seen-mark important-mark) + numbers flag-table) + (elmo-mark-folder-msgdb-create folder numbers)) + +(defun elmo-mark-folder-msgdb-create (folder numbers) (let ((i 0) (len (length numbers)) overview number-alist mark-alist entity message-id @@ -127,7 +122,7 @@ (list overview number-alist mark-alist))) (luna-define-method elmo-folder-append-buffer ((folder elmo-mark-folder) - unread &optional number) + &optional flag number) (let* ((msgid (elmo-field-body "message-id")) (path (elmo-file-cache-get-path msgid)) dir) @@ -164,25 +159,6 @@ (luna-define-method elmo-folder-writable-p ((folder elmo-mark-folder)) t) -;;; To override elmo-map-folder methods. -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-mark-folder) unread-marks &optional mark-alist) - t) - -(luna-define-method elmo-folder-unmark-important ((folder elmo-mark-folder) - numbers) - t) - -(luna-define-method elmo-folder-mark-as-important ((folder elmo-mark-folder) - numbers) - t) - -(luna-define-method elmo-folder-unmark-read ((folder elmo-mark-folder) numbers) - t) - -(luna-define-method elmo-folder-mark-as-read ((folder elmo-mark-folder) numbers) - t) - (require 'product) (product-provide (provide 'elmo-mark) (require 'elmo-version)) diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index 9bf2a2a..49f1b45 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -38,20 +38,154 @@ (require 'std11) (require 'mime) +(defcustom elmo-msgdb-new-mark "N" + "Mark for new message." + :type '(string :tag "Mark") + :group 'elmo) + +(defcustom elmo-msgdb-unread-uncached-mark "U" + "Mark for unread and uncached message." + :type '(string :tag "Mark") + :group 'elmo) + +(defcustom elmo-msgdb-unread-cached-mark "!" + "Mark for unread but already cached message." + :type '(string :tag "Mark") + :group 'elmo) + +(defcustom elmo-msgdb-read-uncached-mark "u" + "Mark for read but uncached message." + :type '(string :tag "Mark") + :group 'elmo) + +;; Not implemented yet. +(defcustom elmo-msgdb-answered-cached-mark "&" + "Mark for answered and cached message." + :type '(string :tag "Mark") + :group 'elmo) + +(defcustom elmo-msgdb-answered-uncached-mark "A" + "Mark for answered but cached message." + :type '(string :tag "Mark") + :group 'elmo) + +(defcustom elmo-msgdb-important-mark"$" + "Mark for important message." + :type '(string :tag "Mark") + :group 'elmo) + ;;; MSGDB interface. +;; +;; MSGDB elmo-load-msgdb PATH +;; MARK elmo-msgdb-get-mark MSGDB NUMBER + +;; CACHED elmo-msgdb-get-cached MSGDB NUMBER +;; VOID elmo-msgdb-set-cached MSGDB NUMBER CACHED USE-CACHE +;; VOID elmo-msgdb-set-flag MSGDB FOLDER NUMBER FLAG +;; VOID elmo-msgdb-unset-flag MSGDB FOLDER NUMBER FLAG + +;; LIST-OF-NUMBERS elmo-msgdb-count-marks MSGDB +;; NUMBER elmo-msgdb-get-number MSGDB MESSAGE-ID +;; FIELD-VALUE elmo-msgdb-get-field MSGDB NUMBER FIELD +;; MSGDB elmo-msgdb-append MSGDB MSGDB-APPEND +;; MSGDB elmo-msgdb-clear MSGDB +;; elmo-msgdb-delete-msgs MSGDB NUMBERS +;; elmo-msgdb-sort-by-date MSGDB + +;;; +;; LIST-OF-NUMBERS elmo-msgdb-list-messages MSGDB + +;; elmo-flag-table-load +;; elmo-flag-table-set +;; elmo-flag-table-get +;; elmo-flag-table-save + +;; elmo-msgdb-append-entity +;; msgdb entity flag-table + +;; ENTITY elmo-msgdb-make-entity ARGS +;; VALUE elmo-msgdb-entity-field ENTITY +;; + +;; OVERVIEW elmo-msgdb-get-overview MSGDB +;; NUMBER-ALIST elmo-msgdb-get-number-alist MSGDB +;; MARK-ALIST elmo-msgdb-get-mark-alist MSGDB +;; elmo-msgdb-change-mark MSGDB BEFORE AFTER + +;; (for internal use?) +;; LIST-OF-MARKS elmo-msgdb-unread-marks +;; LIST-OF-MARKS elmo-msgdb-answered-marks +;; LIST-OF-MARKS elmo-msgdb-uncached-marks +;; elmo-msgdb-seen-save DIR OBJ +;; elmo-msgdb-overview-save DIR OBJ + +;; elmo-msgdb-message-entity MSGDB KEY + +;;; Abolish +;; elmo-msgdb-overview-entity-get-references ENTITY +;; elmo-msgdb-overview-entity-set-references ENTITY +;; elmo-msgdb-get-parent-entity ENTITY MSGDB +;; elmo-msgdb-overview-enitty-get-number ENTITY +;; elmo-msgdb-overview-enitty-get-from-no-decode ENTITY +;; elmo-msgdb-overview-enitty-get-from ENTITY +;; elmo-msgdb-overview-enitty-get-subject-no-decode ENTITY +;; elmo-msgdb-overview-enitty-get-subject ENTITY +;; elmo-msgdb-overview-enitty-get-date ENTITY +;; elmo-msgdb-overview-enitty-get-to ENTITY +;; elmo-msgdb-overview-enitty-get-cc ENTITY +;; elmo-msgdb-overview-enitty-get-size ENTITY +;; elmo-msgdb-overview-enitty-get-id ENTITY +;; elmo-msgdb-overview-enitty-get-extra-field ENTITY +;; elmo-msgdb-overview-enitty-get-extra ENTITY +;; elmo-msgdb-overview-get-entity ID MSGDB + +;; elmo-msgdb-killed-list-load DIR +;; elmo-msgdb-killed-list-save DIR +;; elmo-msgdb-append-to-killed-list FOLDER MSG +;; elmo-msgdb-killed-list-length KILLED-LIST +;; elmo-msgdb-max-of-killed KILLED-LIST +;; elmo-msgdb-killed-message-p KILLED-LIST MSG +;; elmo-living-messages MESSAGES KILLED-LIST +;; elmo-msgdb-finfo-load +;; elmo-msgdb-finfo-save +;; elmo-msgdb-flist-load +;; elmo-msgdb-flist-save + +;; elmo-crosspost-alist-load +;; elmo-crosspost-alist-save + +;; elmo-msgdb-create-overview-from-buffer NUMBER SIZE TIME +;; elmo-msgdb-copy-overview-entity ENTITY +;; elmo-msgdb-create-overview-entity-from-file NUMBER FILE +;; elmo-msgdb-overview-sort-by-date OVERVIEW +;; elmo-msgdb-clear-index + +;; elmo-folder-get-info +;; elmo-folder-get-info-max +;; elmo-folder-get-info-length +;; elmo-folder-get-info-unread + +;; elmo-msgdb-list-flagged MSGDB FLAG +;; (MACRO) elmo-msgdb-do-each-entity + (defun elmo-load-msgdb (path) "Load the MSGDB from PATH." (let ((inhibit-quit t)) (elmo-make-msgdb (elmo-msgdb-overview-load path) (elmo-msgdb-number-load path) - (elmo-msgdb-mark-load path)))) + (elmo-msgdb-mark-load path) + path))) -(defun elmo-make-msgdb (&optional overview number-alist mark-alist) +(defun elmo-make-msgdb (&optional overview number-alist mark-alist path) "Make a MSGDB." - (let ((msgdb (list overview number-alist mark-alist nil))) + (let ((msgdb (list overview number-alist mark-alist nil path))) (elmo-msgdb-make-index msgdb) msgdb)) +(defun elmo-msgdb-list-messages (msgdb) + "List message numbers in the MSGDB." + (mapcar 'car (elmo-msgdb-get-number-alist msgdb))) + (defsubst elmo-msgdb-get-mark (msgdb number) "Get mark string from MSGDB which corresponds to the message with NUMBER." (cadr (elmo-get-hash-val (format "#%d" number) @@ -60,25 +194,174 @@ (defsubst elmo-msgdb-set-mark (msgdb number mark) "Set MARK of the message with NUMBER in the MSGDB. if MARK is nil, mark is removed." - (elmo-msgdb-set-mark-alist - msgdb - (elmo-msgdb-mark-alist-set (elmo-msgdb-get-mark-alist msgdb) - number - mark msgdb)) - (unless mark - (elmo-clear-hash-val (format "#%d" number) - (elmo-msgdb-get-mark-hashtb msgdb)))) - -(defsubst elmo-msgdb-count-marks (msgdb new-mark unread-marks) - (let ((new 0) - (unreads 0)) - (dolist (elem (elmo-msgdb-get-mark-alist msgdb)) - (cond - ((string= (cadr elem) new-mark) - (incf new)) - ((member (cadr elem) unread-marks) - (incf unreads)))) - (cons new unreads))) + (let ((elem (elmo-get-hash-val (format "#%d" number) + (elmo-msgdb-get-mark-hashtb msgdb)))) + (if elem + (if mark + ;; Set mark of the elem + (setcar (cdr elem) mark) + ;; Delete elem from mark-alist + (elmo-msgdb-set-mark-alist + msgdb + (delq elem (elmo-msgdb-get-mark-alist msgdb))) + (elmo-clear-hash-val (format "#%d" number) + (elmo-msgdb-get-mark-hashtb msgdb))) + (when mark + ;; Append new element. + (elmo-msgdb-set-mark-alist + msgdb + (nconc + (elmo-msgdb-get-mark-alist msgdb) + (list (setq elem (list number mark))))) + (elmo-set-hash-val (format "#%d" number) elem + (elmo-msgdb-get-mark-hashtb msgdb)))) + ;; return value. + t)) + +(defun elmo-msgdb-get-cached (msgdb number) + "Return non-nil if message is cached." + (not (member (elmo-msgdb-get-mark msgdb number) + (elmo-msgdb-uncached-marks)))) + +(defun elmo-msgdb-set-cached (msgdb number cached use-cache) + "Set message cache status. +If mark is changed, return non-nil." + (let* ((cur-mark (elmo-msgdb-get-mark msgdb number)) + (cur-flag (cond + ((string= cur-mark elmo-msgdb-important-mark) + 'important) + ((member cur-mark (elmo-msgdb-answered-marks)) + 'answered) + ((not (member cur-mark (elmo-msgdb-unread-marks))) + 'read))) + (cur-cached (elmo-file-cache-exists-p + (elmo-msgdb-get-field msgdb number 'message-id)))) + (unless (eq cached cur-cached) + (case cur-flag + (read + (elmo-msgdb-set-mark msgdb number + (if (and use-cache (not cached)) + elmo-msgdb-read-uncached-mark))) + (important nil) + (answered + (elmo-msgdb-set-mark msgdb number + (if cached + elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark))) + (t + (elmo-msgdb-set-mark msgdb number + (if cached + elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark))))))) + +(defun elmo-msgdb-set-flag (msgdb folder number flag) + "Set message flag. +MSGDB is the ELMO msgdb. +FOLDER is a ELMO folder structure. +NUMBER is a message number to set flag. +FLAG is a symbol which is one of the following: +`read' ... Messages which are already read. +`important' ... Messages which are marked as important. +`answered' ... Messages which are marked as answered." + (let* ((cur-mark (elmo-msgdb-get-mark msgdb number)) + (use-cache (elmo-message-use-cache-p folder number)) + (cur-flag (cond + ((string= cur-mark elmo-msgdb-important-mark) + 'important) + ((member cur-mark (elmo-msgdb-answered-marks)) + 'answered) + ((not (member cur-mark (elmo-msgdb-unread-marks))) + 'read))) + (cur-cached (elmo-file-cache-exists-p + (elmo-msgdb-get-field msgdb number 'message-id))) + mark-modified) + (case flag + (read + (case cur-flag + ((read important)) ; answered mark is overriden. + (t (elmo-msgdb-set-mark msgdb number + (if (and use-cache (not cur-cached)) + elmo-msgdb-read-uncached-mark)) + (setq mark-modified t)))) + (important + (unless (eq cur-flag 'important) + (elmo-msgdb-set-mark msgdb number elmo-msgdb-important-mark) + (setq mark-modified t))) + (answered + (unless (or (eq cur-flag 'answered) (eq cur-flag 'important)) + (elmo-msgdb-set-mark msgdb number + (if cur-cached + elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark))) + (setq mark-modified t))) + (if mark-modified (elmo-folder-set-mark-modified-internal folder t)))) + +(defun elmo-msgdb-unset-flag (msgdb folder number flag) + "Unset message flag. +MSGDB is the ELMO msgdb. +FOLDER is a ELMO folder structure. +NUMBER is a message number to be set flag. +FLAG is a symbol which is one of the following: +`read' ... Messages which are already read. +`important' ... Messages which are marked as important. +`answered' ... Messages which are marked as answered." + (let* ((cur-mark (elmo-msgdb-get-mark msgdb number)) + (use-cache (elmo-message-use-cache-p folder number)) + (cur-flag (cond + ((string= cur-mark elmo-msgdb-important-mark) + 'important) + ((member cur-mark (elmo-msgdb-answered-marks)) + 'answered) + ((not (member cur-mark (elmo-msgdb-unread-marks))) + 'read))) + (cur-cached (elmo-file-cache-exists-p + (elmo-msgdb-get-field msgdb number 'message-id))) + mark-modified) + (case flag + (read + (when (or (eq cur-flag 'read) (eq cur-flag 'answered)) + (elmo-msgdb-set-mark msgdb number + (if cur-cached + elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark)) + (setq mark-modified t))) + (important + (when (eq cur-flag 'important) + (elmo-msgdb-set-mark msgdb number nil) + (setq mark-modified t))) + (answered + (when (eq cur-flag 'answered) + (elmo-msgdb-set-mark msgdb number + (if (and use-cache (not cur-cached)) + elmo-msgdb-read-uncached-mark)) + (setq mark-modified t)))) + (if mark-modified (elmo-folder-set-mark-modified-internal folder t)))) + +(defvar elmo-msgdb-unread-marks-internal nil) +(defsubst elmo-msgdb-unread-marks () + "Return an unread mark list" + (or elmo-msgdb-unread-marks-internal + (setq elmo-msgdb-unread-marks-internal + (list elmo-msgdb-new-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-unread-cached-mark)))) + +(defvar elmo-msgdb-answered-marks-internal nil) +(defsubst elmo-msgdb-answered-marks () + "Return an answered mark list" + (or elmo-msgdb-answered-marks-internal + (setq elmo-msgdb-answered-marks-internal + (list elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark)))) + +(defvar elmo-msgdb-uncached-marks-internal nil) +(defsubst elmo-msgdb-uncached-marks () + (or elmo-msgdb-uncached-marks-internal + (setq elmo-msgdb-uncached-marks-internal + (list elmo-msgdb-new-mark + elmo-msgdb-answered-uncached-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-read-uncached-mark)))) (defsubst elmo-msgdb-get-number (msgdb message-id) "Get number of the message which corrensponds to MESSAGE-ID from MSGDB." @@ -115,7 +398,8 @@ if MARK is nil, mark is removed." (elmo-msgdb-make-index msgdb (elmo-msgdb-get-overview msgdb-append) - (elmo-msgdb-get-mark-alist msgdb-append)))) + (elmo-msgdb-get-mark-alist msgdb-append)) + (nth 4 msgdb))) (defsubst elmo-msgdb-clear (&optional msgdb) (if msgdb @@ -123,8 +407,9 @@ if MARK is nil, mark is removed." (setcar msgdb nil) (setcar (cdr msgdb) nil) (setcar (cddr msgdb) nil) - (setcar (nthcdr 3 msgdb) nil)) - (list nil nil nil nil))) + (setcar (nthcdr 3 msgdb) nil) + (setcar (nthcdr 4 msgdb) nil)) + (list nil nil nil nil nil))) (defun elmo-msgdb-delete-msgs (msgdb msgs) "Delete MSGS from MSGDB @@ -133,7 +418,8 @@ content of MSGDB is changed." (number-alist (cadr msgdb)) (mark-alist (caddr msgdb)) (index (elmo-msgdb-get-index msgdb)) - (newmsgdb (list overview number-alist mark-alist index)) + (newmsgdb (list overview number-alist mark-alist index + (nth 4 msgdb))) ov-entity) ;; remove from current database. (while msgs @@ -160,19 +446,6 @@ content of MSGDB is changed." (message "Sorting...done") (list overview (nth 1 msgdb)(nth 2 msgdb)))) -(defun elmo-msgdb-make-entity (&rest args) - "Make an msgdb entity." - (cons (plist-get args :message-id) - (vector (plist-get args :number) - (plist-get args :references) - (plist-get args :from) - (plist-get args :subject) - (plist-get args :date) - (plist-get args :to) - (plist-get args :cc) - (plist-get args :size) - (plist-get args :extra)))) - ;;; (defsubst elmo-msgdb-append-element (list element) (if list @@ -199,6 +472,9 @@ content of MSGDB is changed." (defsubst elmo-msgdb-get-mark-hashtb (msgdb) (cdr (nth 3 msgdb))) +(defsubst elmo-msgdb-get-path (msgdb) + (nth 4 msgdb)) + ;; ;; number <-> Message-ID handling ;; @@ -208,49 +484,80 @@ content of MSGDB is changed." (elmo-msgdb-append-element ret-val (cons number id))) ret-val)) +;;; flag table +;; +(defvar elmo-flag-table-filename "flag-table") +(defun elmo-flag-table-load (dir) + "Load flag hashtable for MSGDB." + (let ((table (elmo-make-hash)) + ;; For backward compatibility + (seen-file (expand-file-name elmo-msgdb-seen-filename dir)) + seen-list) + (when (file-exists-p seen-file) + (setq seen-list (elmo-object-load seen-file)) + (delete-file seen-file)) + (dolist (msgid seen-list) + (elmo-set-hash-val msgid 'read table)) + (dolist (pair (elmo-object-load + (expand-file-name elmo-flag-table-filename dir))) + (elmo-set-hash-val (car pair) (cdr pair) table)) + table)) + +(defun elmo-flag-table-set (flag-table msg-id flag) + (elmo-set-hash-val msg-id flag flag-table)) + +(defun elmo-flag-table-get (flag-table msg-id) + (elmo-get-hash-val msg-id flag-table)) + +(defun elmo-flag-table-save (dir flag-table) + (elmo-object-save + (expand-file-name elmo-flag-table-filename dir) + (if flag-table + (let (list) + (mapatoms (lambda (atom) + (setq list (cons (cons (symbol-name atom) + (symbol-value atom)) + list))) + flag-table) + list)))) ;;; ;; persistent mark handling ;; (for each folder) -(defun elmo-msgdb-mark-alist-set (alist id mark msgdb) - (let ((ret-val alist) - entity) - (setq entity (assq id alist)) - (if entity - (if (eq mark nil) - ;; delete this entity - (setq ret-val (delq entity alist)) - ;; set mark - (setcar (cdr entity) mark)) - (when mark - (setq ret-val (elmo-msgdb-append-element ret-val - (setq entity - (list id mark)))) - (elmo-set-hash-val (format "#%d" id) entity - (elmo-msgdb-get-mark-hashtb msgdb)))) - ret-val)) (defun elmo-msgdb-mark-append (alist id mark) "Append mark." (setq alist (elmo-msgdb-append-element alist (list id mark)))) -(defun elmo-msgdb-seen-list (msgdb seen-marks) - "Get SEEN-MSGID-LIST from MSGDB." - (let ((ov (elmo-msgdb-get-overview msgdb)) - mark seen-list) - (while ov - (if (setq mark (elmo-msgdb-get-mark - msgdb - (elmo-msgdb-overview-entity-get-number (car ov)))) - (if (and mark (member mark seen-marks)) - (setq seen-list (cons - (elmo-msgdb-overview-entity-get-id (car ov)) - seen-list))) - (setq seen-list (cons - (elmo-msgdb-overview-entity-get-id (car ov)) - seen-list))) - (setq ov (cdr ov))) - seen-list)) +(defsubst elmo-msgdb-length (msgdb) + (length (elmo-msgdb-get-overview msgdb))) + +(defun elmo-msgdb-flag-table (msgdb &optional flag-table) + ;; Make a table of msgid flag (read, answered) + (let ((flag-table (or flag-table (elmo-make-hash (elmo-msgdb-length msgdb)))) + mark) + (dolist (ov (elmo-msgdb-get-overview msgdb)) + (setq mark (elmo-msgdb-get-mark + msgdb + (elmo-msgdb-overview-entity-get-number ov))) + (cond + ((null mark) + (elmo-set-hash-val + (elmo-msgdb-overview-entity-get-id ov) + 'read + flag-table)) + ((and mark (member mark (elmo-msgdb-answered-marks))) + (elmo-set-hash-val + (elmo-msgdb-overview-entity-get-id ov) + 'answered + flag-table)) + ((and mark (not (member mark + (elmo-msgdb-unread-marks)))) + (elmo-set-hash-val + (elmo-msgdb-overview-entity-get-id ov) + 'read + flag-table)))) + flag-table)) ;; ;; mime decode cache @@ -277,14 +584,6 @@ content of MSGDB is changed." ;; ;; overview handling ;; - -(defsubst elmo-msgdb-get-field-value (field-name beg end buffer) - (save-excursion - (save-restriction - (set-buffer buffer) - (narrow-to-region beg end) - (elmo-field-body field-name)))) - (defun elmo-multiple-field-body (name &optional boundary) (save-excursion (save-restriction @@ -374,6 +673,35 @@ header separator." (setcar (cdr entity) after)) (setq mark-alist (cdr mark-alist))))) +(defsubst elmo-msgdb-mark (flag cached &optional new) + (if new + (case flag + (read + (if cached + nil + elmo-msgdb-read-uncached-mark)) + (important + elmo-msgdb-important-mark) + (answered + (if cached + elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark)) + (t + (if cached + elmo-msgdb-unread-cached-mark + elmo-msgdb-new-mark))) + (case flag + (unread + (if cached + elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark)) + (important + elmo-msgdb-important-mark) + (answered + (if cached + elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark))))) + (defsubst elmo-msgdb-seen-save (dir obj) (elmo-object-save (expand-file-name elmo-msgdb-seen-filename dir) @@ -384,7 +712,7 @@ header separator." (expand-file-name elmo-msgdb-overview-filename dir) overview)) -(defun elmo-msgdb-match-condition-primitive (condition entity numbers) +(defun elmo-msgdb-match-condition-primitive (condition mark entity numbers) (catch 'unresolved (let ((key (elmo-filter-key condition)) (case-fold-search t) @@ -404,6 +732,26 @@ header separator." entity) numbers))) (string-to-int (elmo-filter-value condition))))) + ((string= key "flag") + (setq result + (cond + ((string= (elmo-filter-value condition) "any") + (not (or (null mark) + (string= mark elmo-msgdb-read-uncached-mark)))) + ((string= (elmo-filter-value condition) "digest") + (not (or (null mark) + (string= mark elmo-msgdb-read-uncached-mark) + (string= mark elmo-msgdb-answered-cached-mark) + (string= mark elmo-msgdb-answered-uncached-mark)))) +;; (member mark (append (elmo-msgdb-answered-marks) +;; (list elmo-msgdb-important-mark) +;; (elmo-msgdb-unread-marks)))) + ((string= (elmo-filter-value condition) "unread") + (member mark (elmo-msgdb-unread-marks))) + ((string= (elmo-filter-value condition) "important") + (string= mark elmo-msgdb-important-mark)) + ((string= (elmo-filter-value condition) "answered") + (member mark (elmo-msgdb-answered-marks)))))) ((string= key "from") (setq result (string-match (elmo-filter-value condition) @@ -446,31 +794,31 @@ header separator." (not result) result)))) -(defun elmo-msgdb-match-condition (condition entity numbers) +(defun elmo-msgdb-match-condition-internal (condition mark entity numbers) (cond ((vectorp condition) - (elmo-msgdb-match-condition-primitive condition entity numbers)) + (elmo-msgdb-match-condition-primitive condition mark entity numbers)) ((eq (car condition) 'and) - (let ((lhs (elmo-msgdb-match-condition (nth 1 condition) - entity numbers))) + (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition) + mark entity numbers))) (cond ((elmo-filter-condition-p lhs) - (let ((rhs (elmo-msgdb-match-condition (nth 2 condition) - entity numbers))) + (let ((rhs (elmo-msgdb-match-condition-internal + (nth 2 condition) mark entity numbers))) (cond ((elmo-filter-condition-p rhs) (list 'and lhs rhs)) (rhs lhs)))) (lhs - (elmo-msgdb-match-condition (nth 2 condition) - entity numbers))))) + (elmo-msgdb-match-condition-internal (nth 2 condition) + mark entity numbers))))) ((eq (car condition) 'or) - (let ((lhs (elmo-msgdb-match-condition (nth 1 condition) - entity numbers))) + (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition) + mark entity numbers))) (cond ((elmo-filter-condition-p lhs) - (let ((rhs (elmo-msgdb-match-condition (nth 2 condition) - entity numbers))) + (let ((rhs (elmo-msgdb-match-condition-internal (nth 2 condition) + mark entity numbers))) (cond ((elmo-filter-condition-p rhs) (list 'or lhs rhs)) (rhs @@ -480,8 +828,22 @@ header separator." (lhs t) (t - (elmo-msgdb-match-condition (nth 2 condition) - entity numbers))))))) + (elmo-msgdb-match-condition-internal (nth 2 condition) + mark entity numbers))))))) + +(defun elmo-msgdb-match-condition (msgdb condition number numbers) + "Check whether the condition of the message is satisfied or not. +MSGDB is the msgdb to search from. +CONDITION is the search condition. +NUMBER is the message number to check. +NUMBERS is the target message number list. +Return CONDITION itself if no entity exists in msgdb." + (let ((entity (elmo-msgdb-overview-get-entity number msgdb))) + (if entity + (elmo-msgdb-match-condition-internal condition + (elmo-msgdb-get-mark msgdb number) + entity numbers) + condition))) (defsubst elmo-msgdb-set-overview (msgdb overview) (setcar msgdb overview)) @@ -495,6 +857,9 @@ header separator." (defsubst elmo-msgdb-set-index (msgdb index) (setcar (cdddr msgdb) index)) +(defsubst elmo-msgdb-set-path (msgdb path) + (setcar (cddddr msgdb) path)) + (defsubst elmo-msgdb-overview-entity-get-references (entity) (and entity (aref (cdr entity) 1))) @@ -591,17 +956,63 @@ header separator." (and entity (aset (cdr entity) 8 extra)) entity) -(defun elmo-msgdb-overview-get-entity-by-number (database number) - (when number - (let ((db database) - entity) - (while db - (if (eq (elmo-msgdb-overview-entity-get-number (car db)) number) - (setq entity (car db) - db nil) ; exit loop - (setq db (cdr db)))) - entity))) +;;; New APIs +(defsubst elmo-msgdb-message-entity (msgdb key) + (elmo-get-hash-val + (cond ((stringp key) key) + ((numberp key) (format "#%d" key))) + (elmo-msgdb-get-entity-hashtb msgdb))) +(defun elmo-msgdb-make-message-entity (&rest args) + "Make an message entity." + (cons (plist-get args :message-id) + (vector (plist-get args :number) + (plist-get args :references) + (plist-get args :from) + (plist-get args :subject) + (plist-get args :date) + (plist-get args :to) + (plist-get args :cc) + (plist-get args :size) + (plist-get args :extra)))) + +(defsubst elmo-msgdb-message-entity-field (entity field &optional decode) + (and entity + (let ((field-value + (case field + (to (aref (cdr entity) 5)) + (cc (aref (cdr entity) 6)) + (date (aref (cdr entity) 4)) + (subject (aref (cdr entity) 3)) + (from (aref (cdr entity) 2)) + (message-id (car entity)) + (references (aref (cdr entity) 1)) + (size (aref (cdr entity) 7)) + (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8))))))) + (if decode + (elmo-msgdb-get-decoded-cache field-value) + field-value)))) + +(defsubst elmo-msgdb-message-entity-set-field (entity field value) + (and entity + (case field + (to (aset (cdr entity) 5 value)) + (cc (aset (cdr entity) 6 value)) + (date (aset (cdr entity) 4 value)) + (subject (aset (cdr entity) 3 value)) + (from (aset (cdr entity) 2 value)) + (message-id (setcar entity value)) + (references (aset (cdr entity) 1 value)) + (size (aset (cdr entity) 7 value)) + (t + (let ((extras (and entity (aref (cdr entity) 8))) + extra) + (if (setq extra (assoc field extras)) + (setcdr extra value) + (aset (cdr entity) 8 (cons (cons (symbol-name field) + value) extras)))))))) + +;;; (defun elmo-msgdb-overview-get-entity (id msgdb) (when id (let ((ht (elmo-msgdb-get-entity-hashtb msgdb))) @@ -629,13 +1040,6 @@ header separator." (defun elmo-msgdb-set-as-killed (killed-list msg) (elmo-number-set-append killed-list msg)) -(defun elmo-msgdb-append-to-killed-list (folder msgs) - (elmo-folder-set-killed-list-internal - folder - (elmo-number-set-append-list - (elmo-folder-killed-list-internal folder) - msgs))) - (defun elmo-msgdb-killed-list-length (killed-list) (let ((killed killed-list) (ret-val 0)) @@ -709,24 +1113,6 @@ header separator." elmo-msgdb-directory) alist)) -(defun elmo-msgdb-add-msgs-to-seen-list (msgs msgdb unread-marks seen-list) - ;; Add to seen list. - (let (mark) - (while msgs - (if (setq mark (elmo-msgdb-get-mark msgdb (car msgs))) - (unless (member mark unread-marks) ;; not unread mark - (setq seen-list - (cons - (elmo-msgdb-get-field msgdb (car msgs) 'message-id) - seen-list))) - ;; no mark ... seen... - (setq seen-list - (cons - (elmo-msgdb-get-field msgdb (car msgs) 'message-id) - seen-list))) - (setq msgs (cdr msgs))) - seen-list)) - (defun elmo-msgdb-get-message-id-from-buffer () (let ((msgid (elmo-field-body "message-id"))) (if msgid @@ -915,12 +1301,40 @@ Return the updated INDEX." elmo-msgdb-location-filename dir) alist)) -(put 'elmo-msgdb-do-each-entity 'lisp-indent-function '1) -(def-edebug-spec elmo-msgdb-do-each-entity - ((symbolp form &rest form) &rest form)) -(defmacro elmo-msgdb-do-each-entity (spec &rest form) - `(dolist (,(car spec) (elmo-msgdb-get-overview ,(car (cdr spec)))) - ,@form)) +(defun elmo-msgdb-list-flagged (msgdb flag) + (let ((case-fold-search nil) + mark-regexp matched) + (case flag + (new + (setq mark-regexp (regexp-quote elmo-msgdb-new-mark))) + (unread + (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks)))) + (answered + (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-answered-marks)))) + (important + (setq mark-regexp (regexp-quote elmo-msgdb-important-mark))) + (read + (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks)))) + (digest + (setq mark-regexp (elmo-regexp-opt + (append (elmo-msgdb-unread-marks) + (list elmo-msgdb-important-mark))))) + (any + (setq mark-regexp (elmo-regexp-opt + (append + (elmo-msgdb-unread-marks) + (elmo-msgdb-answered-marks) + (list elmo-msgdb-important-mark)))))) + (when mark-regexp + (if (eq flag 'read) + (dolist (number (elmo-msgdb-get-number-alist msgdb)) + (unless (string-match mark-regexp (elmo-msgdb-get-mark + msgdb number)) + (setq matched (cons number matched)))) + (dolist (elem (elmo-msgdb-get-mark-alist msgdb)) + (if (string-match mark-regexp (cadr elem)) + (setq matched (cons (car elem) matched)))))) + matched)) (require 'product) (product-provide (provide 'elmo-msgdb) (require 'elmo-version)) diff --git a/elmo/elmo-multi.el b/elmo/elmo-multi.el index bf636c0..55a6caf 100644 --- a/elmo/elmo-multi.el +++ b/elmo/elmo-multi.el @@ -41,6 +41,15 @@ (children divide-number)) (luna-define-internal-accessors 'elmo-multi-folder)) +(defmacro elmo-multi-real-folder-number (folder number) + "Returns a cons cell of real FOLDER and NUMBER." + (` (cons (nth (- + (/ (, number) + (elmo-multi-folder-divide-number-internal (, folder))) + 1) (elmo-multi-folder-children-internal (, folder))) + (% (, number) (elmo-multi-folder-divide-number-internal + (, folder)))))) + (luna-define-method elmo-folder-initialize ((folder elmo-multi-folder) name) @@ -71,6 +80,17 @@ (dolist (fld (elmo-multi-folder-children-internal folder)) (elmo-folder-close-internal fld))) +(luna-define-method elmo-folder-close :after ((folder elmo-multi-folder)) + (dolist (fld (elmo-multi-folder-children-internal folder)) + (elmo-folder-set-msgdb-internal fld nil))) + +(luna-define-method elmo-folder-synchronize ((folder elmo-multi-folder) + &optional ignore-msgdb + no-check) + (dolist (fld (elmo-multi-folder-children-internal folder)) + (elmo-folder-synchronize fld ignore-msgdb no-check)) + 0) + (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-multi-folder)) (expand-file-name (elmo-replace-string-as-filename @@ -109,23 +129,39 @@ (nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1) (elmo-multi-folder-children-internal folder))) -(defun elmo-multi-msgdb (msgdb base) - (list (mapcar (function - (lambda (x) - (elmo-msgdb-overview-entity-set-number - x - (+ base - (elmo-msgdb-overview-entity-get-number x))))) - (nth 0 msgdb)) - (mapcar (function - (lambda (x) (cons - (+ base (car x)) - (cdr x)))) - (nth 1 msgdb)) - (mapcar (function - (lambda (x) (cons - (+ base (car x)) - (cdr x)))) (nth 2 msgdb)))) +(luna-define-method elmo-message-entity ((folder elmo-multi-folder) key) + (cond + ((numberp key) + (let* ((pair (elmo-multi-real-folder-number folder key)) + (entity (elmo-message-entity (car pair) (cdr pair)))) + (when entity + (elmo-message-entity-set-number (elmo-message-copy-entity entity) + key)))) + ((stringp key) + (let ((children (elmo-multi-folder-children-internal folder)) + (cur-number 0) + match) + (while children + (setq cur-number (+ cur-number 1)) + (when (setq match (elmo-message-entity (car children) key)) + (setq match (elmo-message-copy-entity match)) + (elmo-message-entity-set-number + match + (+ (* (elmo-multi-folder-divide-number-internal folder) + cur-number) + (elmo-message-entity-number match))) + (setq children nil)) + (setq children (cdr children))) + match)))) + +(luna-define-method elmo-message-field ((folder elmo-multi-folder) + number field) + (let ((pair (elmo-multi-real-folder-number folder number))) + (elmo-message-field (car pair) (cdr pair) field))) + +(luna-define-method elmo-message-mark ((folder elmo-multi-folder) number) + (let ((pair (elmo-multi-real-folder-number folder number))) + (elmo-message-mark (car pair) (cdr pair)))) (defun elmo-multi-split-numbers (folder numlist &optional as-is) (let ((numbers (sort numlist '<)) @@ -151,108 +187,9 @@ (setq numbers-list (nconc numbers-list (list one-list)))) numbers-list)) -(luna-define-method elmo-folder-msgdb-create ((folder elmo-multi-folder) - numbers new-mark already-mark - seen-mark important-mark - seen-list) - (let* ((folders (elmo-multi-folder-children-internal folder)) - overview number-alist mark-alist entity - numbers-list - cur-number - i percent num - msgdb) - (setq numbers-list (elmo-multi-split-numbers folder numbers)) - (setq cur-number 0) - (while (< cur-number (length folders)) - (if (nth cur-number numbers-list) - (setq msgdb - (elmo-msgdb-append - msgdb - (elmo-multi-msgdb - (elmo-folder-msgdb-create (nth cur-number folders) - (nth cur-number numbers-list) - new-mark already-mark - seen-mark important-mark - seen-list) - (* (elmo-multi-folder-divide-number-internal folder) - (1+ cur-number)))))) - (setq cur-number (1+ cur-number))) - (elmo-msgdb-sort-by-date msgdb))) - -(luna-define-method elmo-folder-process-crosspost ((folder elmo-multi-folder) - &optional - number-alist) - (let ((number-alists (elmo-multi-split-number-alist - folder - (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder)))) - (cur-number 1)) - (dolist (child (elmo-multi-folder-children-internal folder)) - (elmo-folder-process-crosspost child (car number-alists)) - (setq cur-number (+ 1 cur-number) - number-alists (cdr number-alists))))) - -(defsubst elmo-multi-folder-append-msgdb (folder append-msgdb) - (if append-msgdb - (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb)) - (all-alist (copy-sequence (append - (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder)) - number-alist))) - (cur number-alist) - overview to-be-deleted - mark-alist same) - (while cur - (setq all-alist (delq (car cur) all-alist)) - ;; same message id exists. - (if (setq same (rassoc (cdr (car cur)) all-alist)) - (unless (= (/ (car (car cur)) - (elmo-multi-folder-divide-number-internal folder)) - (/ (car same) - (elmo-multi-folder-divide-number-internal folder))) - ;; base is also same...delete it! - (setq to-be-deleted - (append to-be-deleted (list (car (car cur))))))) - (setq cur (cdr cur))) - (cond ((eq (elmo-folder-process-duplicates-internal folder) - 'hide) - ;; Hide duplicates. - (elmo-msgdb-append-to-killed-list folder to-be-deleted) - (setq overview (elmo-delete-if - (lambda (x) - (memq (elmo-msgdb-overview-entity-get-number - x) - to-be-deleted)) - (elmo-msgdb-get-overview append-msgdb))) - ;; Should be mark as read. - (elmo-folder-mark-as-read folder to-be-deleted) - (elmo-msgdb-set-overview append-msgdb overview)) - ((eq (elmo-folder-process-duplicates-internal folder) - 'read) - ;; Mark as read duplicates. - (elmo-folder-mark-as-read folder to-be-deleted)) - (t - ;; Do nothing. - (setq to-be-deleted nil))) - (elmo-folder-set-msgdb-internal folder - (elmo-msgdb-append - (elmo-folder-msgdb folder) - append-msgdb)) - (length to-be-deleted)) - 0)) - -(luna-define-method elmo-folder-append-msgdb ((folder elmo-multi-folder) - append-msgdb) - (elmo-multi-folder-append-msgdb folder append-msgdb)) - -(defmacro elmo-multi-real-folder-number (folder number) - "Returns a cons cell of real FOLDER and NUMBER." - (` (cons (nth (- - (/ (, number) - (elmo-multi-folder-divide-number-internal (, folder))) - 1) (elmo-multi-folder-children-internal (, folder))) - (% (, number) (elmo-multi-folder-divide-number-internal - (, folder)))))) +(luna-define-method elmo-folder-process-crosspost ((folder elmo-multi-folder)) + (dolist (child (elmo-multi-folder-children-internal folder)) + (elmo-folder-process-crosspost child))) (defsubst elmo-multi-find-fetch-strategy (folder entity ignore-cache) (if entity @@ -288,43 +225,31 @@ (setq cur-number (+ 1 cur-number))) t)) +(luna-define-method elmo-folder-detach-messages ((folder elmo-multi-folder) + numbers) + (let ((flds (elmo-multi-folder-children-internal folder)) + one-list-list + (cur-number 0)) + (setq one-list-list (elmo-multi-split-numbers folder numbers)) + (while (< cur-number (length flds)) + (elmo-folder-detach-messages (nth cur-number flds) + (nth cur-number one-list-list)) + (setq cur-number (+ 1 cur-number))) + t)) + (luna-define-method elmo-folder-diff ((folder elmo-multi-folder) &optional numbers) (elmo-multi-folder-diff folder numbers)) (defun elmo-multi-folder-diff (folder numbers) (let ((flds (elmo-multi-folder-children-internal folder)) - (numbers (mapcar 'car - (elmo-msgdb-number-load - (elmo-folder-msgdb-path folder)))) - (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))) - (count 0) + (num-list (and numbers (elmo-multi-split-numbers folder numbers))) (unsync 0) (messages 0) - num-list - diffs nums) - ;; If first time, dummy numbers is used as current number list. - (unless numbers - (let ((i 0) - (divider (elmo-multi-folder-divide-number-internal folder))) - (dolist (folder flds) - (setq i (+ i 1)) - (setq numbers - (cons (* i divider) numbers))))) - (setq num-list - (elmo-multi-split-numbers folder - (elmo-uniq-list - (nconc - (elmo-number-set-to-number-list killed) - numbers)))) + diffs) (while flds - (setq nums (elmo-folder-diff (car flds) (car num-list)) - nums (cons (or (elmo-diff-unread nums) - (elmo-diff-new nums)) - (elmo-diff-all nums))) - (setq diffs (nconc diffs (list nums))) - (setq count (+ 1 count)) - (setq num-list (cdr num-list)) + (setq diffs (nconc diffs (list (elmo-folder-diff (car flds) + (car num-list))))) (setq flds (cdr flds))) (while diffs (and (car (car diffs)) @@ -334,152 +259,72 @@ (elmo-folder-set-info-hashtb folder nil messages) (cons unsync messages))) -(defun elmo-multi-split-number-alist (folder number-alist) - (let ((alist (sort (copy-sequence number-alist) - (lambda (pair1 pair2) - (< (car pair1)(car pair2))))) - (cur-number 0) - one-alist split num) - (while alist - (setq cur-number (+ cur-number 1)) - (setq one-alist nil) - (while (and alist - (eq 0 - (/ (- (setq num (car (car alist))) - (* elmo-multi-divide-number cur-number)) - (elmo-multi-folder-divide-number-internal folder)))) - (setq one-alist (nconc - one-alist - (list - (cons - (% num (* (elmo-multi-folder-divide-number-internal - folder) cur-number)) - (cdr (car alist)))))) - (setq alist (cdr alist))) - (setq split (nconc split (list one-alist)))) - split)) - -(defun elmo-multi-split-mark-alist (folder mark-alist) +(luna-define-method elmo-folder-list-unreads ((folder elmo-multi-folder)) (let ((cur-number 0) - (alist (sort (copy-sequence mark-alist) - (lambda (pair1 pair2) - (< (car pair1)(car pair2))))) - one-alist result) - (while alist + unreads) + (dolist (child (elmo-multi-folder-children-internal folder)) (setq cur-number (+ cur-number 1)) - (setq one-alist nil) - (while (and alist - (eq 0 - (/ (- (car (car alist)) - (* (elmo-multi-folder-divide-number-internal - folder) cur-number)) - (elmo-multi-folder-divide-number-internal folder)))) - (setq one-alist (nconc - one-alist - (list - (list (% (car (car alist)) - (* (elmo-multi-folder-divide-number-internal - folder) cur-number)) - (cadr (car alist)))))) - (setq alist (cdr alist))) - (setq result (nconc result (list one-alist)))) - result)) - -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-multi-folder) unread-marks &optional mark-alist) - (elmo-multi-folder-list-unreads-internal folder unread-marks)) - -(defun elmo-multi-folder-list-unreads-internal (folder unread-marks) - (let ((folders (elmo-multi-folder-children-internal folder)) - (mark-alists (elmo-multi-split-mark-alist - folder - (elmo-msgdb-get-mark-alist - (elmo-folder-msgdb folder)))) - (cur-number 0) - unreads - all-unreads) - (while folders + (setq unreads + (nconc + unreads + (mapcar (lambda (x) + (+ x (* cur-number + (elmo-multi-folder-divide-number-internal + folder)))) + (elmo-folder-list-unreads child))))) + unreads)) + +(luna-define-method elmo-folder-list-answereds ((folder elmo-multi-folder)) + (let ((cur-number 0) + answereds) + (dolist (child (elmo-multi-folder-children-internal folder)) (setq cur-number (+ cur-number 1)) - (unless (listp (setq unreads - (elmo-folder-list-unreads-internal - (car folders) unread-marks (car mark-alists)))) - (setq unreads (delq nil - (mapcar - (lambda (x) - (if (member (cadr x) unread-marks) - (car x))) - (car mark-alists))))) - (setq all-unreads - (nconc all-unreads - (mapcar - (lambda (x) - (+ x - (* cur-number - (elmo-multi-folder-divide-number-internal - folder)))) - unreads))) - (setq mark-alists (cdr mark-alists) - folders (cdr folders))) - all-unreads)) - -(luna-define-method elmo-folder-list-importants-internal - ((folder elmo-multi-folder) important-mark) - (let ((folders (elmo-multi-folder-children-internal folder)) - (mark-alists (elmo-multi-split-mark-alist - folder - (elmo-msgdb-get-mark-alist - (elmo-folder-msgdb folder)))) - (cur-number 0) - importants - all-importants) - (while folders + (setq answereds + (nconc + answereds + (mapcar (lambda (x) + (+ x (* cur-number + (elmo-multi-folder-divide-number-internal + folder)))) + (elmo-folder-list-answereds child))))) + answereds)) + +(luna-define-method elmo-folder-list-importants ((folder elmo-multi-folder)) + (let ((cur-number 0) + importants) + (dolist (child (elmo-multi-folder-children-internal folder)) (setq cur-number (+ cur-number 1)) - (when (listp (setq importants - (elmo-folder-list-importants-internal - (car folders) important-mark))) - (setq all-importants - (nconc all-importants - (mapcar - (lambda (x) - (+ x - (* cur-number - (elmo-multi-folder-divide-number-internal - folder)))) - importants)))) - (setq mark-alists (cdr mark-alists) - folders (cdr folders))) - all-importants)) - -(luna-define-method elmo-folder-list-messages-internal - ((folder elmo-multi-folder) &optional nohide) + (setq importants + (nconc + importants + (mapcar (lambda (x) + (+ x (* cur-number + (elmo-multi-folder-divide-number-internal + folder)))) + (elmo-folder-list-importants child))))) + (elmo-uniq-list + (nconc importants + (elmo-folder-list-messages-with-global-mark + folder elmo-msgdb-important-mark))))) + +(luna-define-method elmo-folder-list-messages + ((folder elmo-multi-folder) &optional visible-only in-msgdb) (let* ((flds (elmo-multi-folder-children-internal folder)) (cur-number 0) list numbers) (while flds (setq cur-number (+ cur-number 1)) - (setq list (elmo-folder-list-messages-internal (car flds))) + (setq list (elmo-folder-list-messages (car flds) visible-only in-msgdb)) (setq numbers - (append + (nconc numbers - (if (listp list) - (mapcar - (function - (lambda (x) - (+ - (* (elmo-multi-folder-divide-number-internal - folder) cur-number) x))) - list) - ;; Use current list. - (elmo-delete-if - (lambda (num) - (not - (eq cur-number (/ num - (elmo-multi-folder-divide-number-internal - folder))))) - (mapcar - 'car - (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder))))))) + (mapcar + (function + (lambda (x) + (+ + (* (elmo-multi-folder-divide-number-internal + folder) cur-number) x))) + list))) (setq flds (cdr flds))) numbers)) @@ -601,33 +446,98 @@ (setq msg-list (cdr msg-list))) ret-val)) -(luna-define-method elmo-folder-mark-as-important ((folder elmo-multi-folder) - numbers) +(luna-define-method elmo-folder-mark-as-important ((folder + elmo-multi-folder) + numbers + &optional + ignore-flags) (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers)) (elmo-folder-mark-as-important (car folder-numbers) - (cdr folder-numbers))) - t) - -(luna-define-method elmo-folder-unmark-important ((folder elmo-multi-folder) - numbers) + (cdr folder-numbers) + ignore-flags))) + +(luna-define-method elmo-folder-unmark-important ((folder + elmo-multi-folder) + numbers + &optional + ignore-flags) (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers)) (elmo-folder-unmark-important (car folder-numbers) - (cdr folder-numbers))) - t) + (cdr folder-numbers) + ignore-flags))) -(luna-define-method elmo-folder-mark-as-read ((folder elmo-multi-folder) - numbers) +(luna-define-method elmo-folder-mark-as-read ((folder + elmo-multi-folder) + numbers + &optional ignore-flag) (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers)) (elmo-folder-mark-as-read (car folder-numbers) - (cdr folder-numbers))) - t) + (cdr folder-numbers) + ignore-flag))) -(luna-define-method elmo-folder-unmark-read ((folder elmo-multi-folder) - numbers) +(luna-define-method elmo-folder-unmark-read ((folder + elmo-multi-folder) + numbers + &optional ignore-flag) (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers)) (elmo-folder-unmark-read (car folder-numbers) - (cdr folder-numbers))) - t) + (cdr folder-numbers) + ignore-flag))) + +(luna-define-method elmo-folder-mark-as-answered ((folder + elmo-multi-folder) + numbers) + (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers)) + (elmo-folder-mark-as-answered (car folder-numbers) + (cdr folder-numbers)))) + +(luna-define-method elmo-folder-unmark-answered ((folder + elmo-multi-folder) + numbers) + (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers)) + (elmo-folder-unmark-answered (car folder-numbers) + (cdr folder-numbers)))) + +(luna-define-method elmo-folder-list-flagged ((folder elmo-multi-folder) + flag + &optional in-msgdb) + (let ((cur-number 0) + numbers) + (dolist (child (elmo-multi-folder-children-internal folder)) + (setq cur-number (+ cur-number 1) + numbers + (nconc + numbers + (mapcar + (function + (lambda (x) + (+ + (* (elmo-multi-folder-divide-number-internal folder) + cur-number) x))) + (elmo-folder-list-flagged child flag in-msgdb))))) + numbers)) + +(luna-define-method elmo-folder-commit ((folder elmo-multi-folder)) + (dolist (child (elmo-multi-folder-children-internal folder)) + (elmo-folder-commit child))) + +(luna-define-method elmo-folder-length ((folder elmo-multi-folder)) + (let ((sum 0)) + (dolist (child (elmo-multi-folder-children-internal folder)) + (setq sum (+ sum (elmo-folder-length child)))) + sum)) + +(luna-define-method elmo-folder-count-flags ((folder elmo-multi-folder)) + (let ((new 0) + (unreads 0) + (answered 0) + flags) + (dolist (child (elmo-multi-folder-children-internal folder)) + (setq flags (elmo-folder-count-flags child)) + (setq new (+ new (nth 0 flags))) + (setq unreads (+ unreads (nth 1 flags))) + (setq answered (+ answered (nth 2 flags)))) + (list new unreads answered))) (require 'product) (product-provide (provide 'elmo-multi) (require 'elmo-version)) diff --git a/elmo/elmo-net.el b/elmo/elmo-net.el index 009dcae..06c661e 100644 --- a/elmo/elmo-net.el +++ b/elmo/elmo-net.el @@ -393,19 +393,26 @@ Returned value is searched from `elmo-network-stream-type-alist'." (elmo-dop-spool-folder-list-messages folder)))) t)) -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-net-folder) unread-marks &optional mark-alist) +(luna-define-method elmo-folder-list-unreads :around ((folder + elmo-net-folder)) (if (and (elmo-folder-plugged-p folder) (elmo-folder-use-flag-p folder)) (elmo-folder-send folder 'elmo-folder-list-unreads-plugged) - t)) + (luna-call-next-method))) -(luna-define-method elmo-folder-list-importants-internal - ((folder elmo-net-folder) important-mark) +(luna-define-method elmo-folder-list-importants :around ((folder + elmo-net-folder)) (if (and (elmo-folder-plugged-p folder) (elmo-folder-use-flag-p folder)) (elmo-folder-send folder 'elmo-folder-list-importants-plugged) - t)) + (luna-call-next-method))) + +(luna-define-method elmo-folder-list-answereds :around ((folder + elmo-net-folder)) + (if (and (elmo-folder-plugged-p folder) + (elmo-folder-use-flag-p folder)) + (elmo-folder-send folder 'elmo-folder-list-answereds-plugged) + (luna-call-next-method))) (luna-define-method elmo-folder-list-unreads-plugged ((folder elmo-net-folder)) @@ -415,6 +422,10 @@ Returned value is searched from `elmo-network-stream-type-alist'." ((folder elmo-net-folder)) t) +(luna-define-method elmo-folder-list-answereds-plugged + ((folder elmo-net-folder)) + t) + (luna-define-method elmo-folder-delete-messages ((folder elmo-net-folder) numbers) (if (elmo-folder-plugged-p folder) @@ -427,72 +438,87 @@ Returned value is searched from `elmo-network-stream-type-alist'." (elmo-folder-delete-messages-dop folder numbers)) (luna-define-method elmo-folder-msgdb-create ((folder elmo-net-folder) - numbers new-mark - already-mark seen-mark - important-mark seen-list) + numbers flag-table) (if (elmo-folder-plugged-p folder) (elmo-folder-send folder 'elmo-folder-msgdb-create-plugged - numbers - new-mark - already-mark seen-mark - important-mark seen-list) + numbers flag-table) (elmo-folder-send folder 'elmo-folder-msgdb-create-unplugged - numbers - new-mark already-mark seen-mark - important-mark seen-list))) + numbers flag-table))) (luna-define-method elmo-folder-msgdb-create-unplugged ((folder elmo-net-folder) numbers - new-mark already-mark - seen-mark - important-mark - seen-list) + flag-table) ;; XXXX should be appended to already existing msgdb. (elmo-dop-msgdb (elmo-folder-msgdb-create (elmo-dop-spool-folder folder) (mapcar 'abs numbers) - new-mark already-mark - seen-mark - important-mark - seen-list))) - -(luna-define-method elmo-folder-unmark-important ((folder elmo-net-folder) - numbers) - (if (elmo-folder-use-flag-p folder) - (if (elmo-folder-plugged-p folder) - (elmo-folder-send folder 'elmo-folder-unmark-important-plugged - numbers) - (elmo-folder-send folder - 'elmo-folder-unmark-important-unplugged numbers)) - t)) - -(luna-define-method elmo-folder-mark-as-important ((folder elmo-net-folder) - numbers) - (if (elmo-folder-use-flag-p folder) - (if (elmo-folder-plugged-p folder) - (elmo-folder-send folder 'elmo-folder-mark-as-important-plugged - numbers) - (elmo-folder-send folder 'elmo-folder-mark-as-important-unplugged - numbers)) - t)) + flag-table))) -(luna-define-method elmo-folder-unmark-read ((folder elmo-net-folder) - numbers) - (if (elmo-folder-use-flag-p folder) - (if (elmo-folder-plugged-p folder) - (elmo-folder-send folder 'elmo-folder-unmark-read-plugged numbers) - (elmo-folder-send folder 'elmo-folder-unmark-read-unplugged numbers)) - t)) - -(luna-define-method elmo-folder-mark-as-read ((folder elmo-net-folder) - numbers) - (if (elmo-folder-use-flag-p folder) - (if (elmo-folder-plugged-p folder) - (elmo-folder-send folder 'elmo-folder-mark-as-read-plugged numbers) - (elmo-folder-send - folder 'elmo-folder-mark-as-read-unplugged numbers)) - t)) +(luna-define-method elmo-folder-unmark-important :before ((folder + elmo-net-folder) + numbers + &optional + ignore-flag) + (when (and (elmo-folder-use-flag-p folder) + (not ignore-flag)) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-unmark-important-plugged + numbers) + (elmo-folder-send folder + 'elmo-folder-unmark-important-unplugged numbers)))) + +(luna-define-method elmo-folder-mark-as-important :before ((folder + elmo-net-folder) + numbers + &optional + ignore-flag) + (when (and (elmo-folder-use-flag-p folder) + (not ignore-flag)) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-mark-as-important-plugged + numbers) + (elmo-folder-send folder 'elmo-folder-mark-as-important-unplugged + numbers)))) + +(luna-define-method elmo-folder-unmark-read :before ((folder elmo-net-folder) + numbers + &optional ignore-flag) + (when (and (elmo-folder-use-flag-p folder) + (not ignore-flag)) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-unmark-read-plugged numbers) + (elmo-folder-send folder 'elmo-folder-unmark-read-unplugged numbers)))) + +(luna-define-method elmo-folder-mark-as-read :before ((folder elmo-net-folder) + numbers + &optional ignore-flag) + (when (and (elmo-folder-use-flag-p folder) + (not ignore-flag)) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-mark-as-read-plugged numbers) + (elmo-folder-send + folder 'elmo-folder-mark-as-read-unplugged numbers)))) + +(luna-define-method elmo-folder-unmark-answered :before ((folder + elmo-net-folder) + numbers) + (when (elmo-folder-use-flag-p folder) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-unmark-answered-plugged + numbers) + (elmo-folder-send folder + 'elmo-folder-unmark-answered-unplugged numbers)))) + +(luna-define-method elmo-folder-mark-as-answered :before ((folder + elmo-net-folder) + numbers) + (when (elmo-folder-use-flag-p folder) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-mark-as-answered-plugged + numbers) + (elmo-folder-send folder 'elmo-folder-mark-as-answered-unplugged + numbers)))) (luna-define-method elmo-folder-mark-as-read-unplugged ((folder elmo-net-folder) @@ -513,6 +539,15 @@ Returned value is searched from `elmo-network-stream-type-alist'." numbers) (elmo-folder-unmark-important-dop folder numbers)) +(luna-define-method elmo-folder-mark-as-answered-unplugged ((folder + elmo-net-folder) + numbers) + (elmo-folder-mark-as-answered-dop folder numbers)) + +(luna-define-method elmo-folder-unmark-answered-unplugged + ((folder elmo-net-folder) numbers) + (elmo-folder-unmark-answered-dop folder numbers)) + (luna-define-method elmo-message-encache :around ((folder elmo-net-folder) number &optional read) (if (elmo-folder-plugged-p folder) diff --git a/elmo/elmo-nmz.el b/elmo/elmo-nmz.el index bc46e71..59fe128 100644 --- a/elmo/elmo-nmz.el +++ b/elmo/elmo-nmz.el @@ -117,10 +117,7 @@ If the value is a list, all elements are used as index paths for namazu." entity)) (luna-define-method elmo-folder-msgdb-create ((folder elmo-nmz-folder) - numlist new-mark - already-mark seen-mark - important-mark - seen-list) + numlist flag-table) (let* (overview number-alist mark-alist entity i percent num pair) (setq num (length numlist)) @@ -148,7 +145,7 @@ If the value is a list, all elements are used as index paths for namazu." (or (elmo-msgdb-global-mark-get (elmo-msgdb-overview-entity-get-id entity)) - new-mark)))) + elmo-msgdb-new-mark)))) (when (> num elmo-display-progress-threshold) (setq i (1+ i)) (setq percent (/ (* i 100) num)) @@ -254,25 +251,6 @@ If the value is a list, all elements are used as index paths for namazu." (luna-define-method elmo-folder-exists-p ((folder elmo-nmz-folder)) t) -;;; To override elmo-map-folder methods. -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-nmz-folder) unread-marks &optional mark-alist) - t) - -(luna-define-method elmo-folder-unmark-important ((folder elmo-nmz-folder) - numbers) - t) - -(luna-define-method elmo-folder-mark-as-important ((folder elmo-nmz-folder) - numbers) - t) - -(luna-define-method elmo-folder-unmark-read ((folder elmo-nmz-folder) numbers) - t) - -(luna-define-method elmo-folder-mark-as-read ((folder elmo-nmz-folder) numbers) - t) - (require 'product) (product-provide (provide 'elmo-nmz) (require 'elmo-version)) diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index 4b889a7..f4fecd5 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -101,7 +101,7 @@ Debug information is inserted in the buffer \"*NNTP DEBUG*\"") (elmo-nntp-folder-set-group-internal folder (elmo-nntp-encode-group-string (car parse))) - (setq explicit-user (eq ?: (string-to-char (cdr parse)))) + (setq explicit-user (eq ?: (string-to-char (cdr parse)))) (setq parse (elmo-parse-prefixed-element ?: (cdr parse))) (elmo-net-folder-set-user-internal folder (if (eq (length (car parse)) 0) @@ -324,11 +324,11 @@ Don't cache if nil.") (run-hooks 'elmo-nntp-opened-hook)) (defun elmo-nntp-process-filter (process output) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert output) - (elmo-nntp-debug "RECEIVED: %s\n" output))) + (when (buffer-live-p (process-buffer process)) + (with-current-buffer (process-buffer process) + (goto-char (point-max)) + (insert output) + (elmo-nntp-debug "RECEIVED: %s\n" output)))) (defun elmo-nntp-send-mode-reader (session) (elmo-nntp-send-command session "mode reader") @@ -734,11 +734,7 @@ Don't cache if nil.") ("xref" . 8))) (defun elmo-nntp-create-msgdb-from-overview-string (str - new-mark - already-mark - seen-mark - important-mark - seen-list + flag-table &optional numlist) (let (ov-list gmark message-id seen ov-entity overview number-alist mark-alist num @@ -793,17 +789,12 @@ Don't cache if nil.") (elmo-msgdb-number-add number-alist num (aref ov-entity 4))) (setq message-id (aref ov-entity 4)) - (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - (if elmo-nntp-use-cache - seen-mark) - new-mark)))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist num gmark)))) @@ -811,16 +802,10 @@ Don't cache if nil.") (list overview number-alist mark-alist))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-nntp-folder) - numbers new-mark already-mark - seen-mark important-mark - seen-list) - (elmo-nntp-folder-msgdb-create folder numbers new-mark already-mark - seen-mark important-mark - seen-list)) - -(defun elmo-nntp-folder-msgdb-create (folder numbers new-mark already-mark - seen-mark important-mark - seen-list) + numbers flag-table) + (elmo-nntp-folder-msgdb-create folder numbers flag-table)) + +(defun elmo-nntp-folder-msgdb-create (folder numbers flag-table) (let ((filter numbers) (session (elmo-nntp-get-session folder)) beg-num end-num cur length @@ -849,11 +834,7 @@ Don't cache if nil.") ret-val (elmo-nntp-create-msgdb-from-overview-string ov-str - new-mark - already-mark - seen-mark - important-mark - seen-list + flag-table filter ))))) (if (null (elmo-nntp-read-response session t)) @@ -874,8 +855,7 @@ Don't cache if nil.") 'elmo-nntp-msgdb-create "Getting overview..." 100))) (if (not use-xover) (setq ret-val (elmo-nntp-msgdb-create-by-header - session numbers - new-mark already-mark seen-mark seen-list)) + session numbers flag-table)) (with-current-buffer (elmo-network-session-buffer session) (if ov-str (setq ret-val @@ -883,11 +863,7 @@ Don't cache if nil.") ret-val (elmo-nntp-create-msgdb-from-overview-string ov-str - new-mark - already-mark - seen-mark - important-mark - seen-list + flag-table filter)))))) (elmo-folder-set-killed-list-internal folder @@ -947,13 +923,11 @@ Don't cache if nil.") (nconc number-alist (list (cons max-number nil)))))))))) -(defun elmo-nntp-msgdb-create-by-header (session numbers - new-mark already-mark - seen-mark seen-list) +(defun elmo-nntp-msgdb-create-by-header (session numbers flag-table) (with-temp-buffer (elmo-nntp-retrieve-headers session (current-buffer) numbers) (elmo-nntp-msgdb-create-message - (length numbers) new-mark already-mark seen-mark seen-list))) + (length numbers) flag-table))) (defun elmo-nntp-parse-xhdr-response (string) (let (response) @@ -1432,8 +1406,7 @@ Returns a list of cons cells like (NUMBER . VALUE)" ;; end of from Gnus -(defun elmo-nntp-msgdb-create-message (len new-mark - already-mark seen-mark seen-list) +(defun elmo-nntp-msgdb-create-message (len flag-table) (save-excursion (let (beg overview number-alist mark-alist entity i num gmark seen message-id) @@ -1465,18 +1438,13 @@ Returns a list of cons cells like (NUMBER . VALUE)" (elmo-msgdb-overview-entity-get-number entity) (car entity))) (setq message-id (car entity)) - (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - (if elmo-nntp-use-cache - seen-mark) - new-mark)))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist @@ -1572,31 +1540,21 @@ Returns a list of cons cells like (NUMBER . VALUE)" folder (delq elem (elmo-nntp-folder-temp-crosses-internal folder))))))) -(luna-define-method elmo-folder-mark-as-read ((folder elmo-nntp-folder) - numbers) - (elmo-nntp-folder-update-crosspost-message-alist folder numbers) - t) - -(luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder) - &optional - number-alist) - (elmo-nntp-folder-process-crosspost folder number-alist)) +(luna-define-method elmo-folder-mark-as-read :before ((folder + elmo-nntp-folder) + numbers + &optional ignore-flags) + (elmo-nntp-folder-update-crosspost-message-alist folder numbers)) -(defun elmo-nntp-folder-process-crosspost (folder number-alist) +(defsubst elmo-nntp-folder-process-crosspost (folder) ;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from ;; `elmo-crosspost-message-alist'. ;; 2.2. remove crosspost entry for current newsgroup from ;; `elmo-crosspost-message-alist'. (let (cross-deletes reads entity ngs) (dolist (cross elmo-crosspost-message-alist) - (if number-alist - (when (setq entity (rassoc (nth 0 cross) number-alist)) - (setq reads (cons (car entity) reads))) - (when (setq entity (elmo-msgdb-overview-get-entity - (nth 0 cross) - (elmo-folder-msgdb folder))) - (setq reads (cons (elmo-msgdb-overview-entity-get-number entity) - reads)))) + (when (setq entity (elmo-message-entity folder (nth 0 cross))) + (setq reads (cons (elmo-message-entity-number entity) reads))) (when entity (if (setq ngs (delete (elmo-nntp-folder-group-internal folder) (nth 1 cross))) @@ -1609,19 +1567,15 @@ Returns a list of cons cells like (NUMBER . VALUE)" elmo-crosspost-message-alist))) (elmo-nntp-folder-set-reads-internal folder reads))) -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-nntp-folder) unread-marks mark-alist) +(luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder)) + (elmo-nntp-folder-process-crosspost folder)) + +(luna-define-method elmo-folder-list-unreads :around ((folder + elmo-nntp-folder)) ;; 2.3. elmo-folder-list-unreads return unread message list according to ;; `reads' slot. - (let ((mark-alist (or mark-alist (elmo-msgdb-get-mark-alist - (elmo-folder-msgdb folder))))) - (elmo-living-messages (delq nil - (mapcar - (lambda (x) - (if (member (nth 1 x) unread-marks) - (car x))) - mark-alist)) - (elmo-nntp-folder-reads-internal folder)))) + (elmo-living-messages (luna-call-next-method) + (elmo-nntp-folder-reads-internal folder))) (require 'product) (product-provide (provide 'elmo-nntp) (require 'elmo-version)) diff --git a/elmo/elmo-pipe.el b/elmo/elmo-pipe.el index b57a9b8..8c3aa2e 100644 --- a/elmo/elmo-pipe.el +++ b/elmo/elmo-pipe.el @@ -50,7 +50,8 @@ (elmo-make-folder (elmo-match-string 3 name))) (elmo-pipe-folder-set-copy-internal folder - (string= ":" (elmo-match-string 2 name)))) + (string= ":" + (elmo-match-string 2 name)))) folder) (luna-define-method elmo-folder-get-primitive-list ((folder elmo-pipe-folder)) @@ -65,27 +66,17 @@ (or (elmo-folder-contains-type (elmo-pipe-folder-src-internal folder) type) (elmo-folder-contains-type (elmo-pipe-folder-dst-internal folder) type))) -(luna-define-method elmo-folder-msgdb-create ((folder elmo-pipe-folder) - numlist new-mark already-mark - seen-mark important-mark - seen-list) - (elmo-folder-msgdb-create (elmo-pipe-folder-dst-internal folder) - numlist new-mark already-mark - seen-mark important-mark seen-list)) - (luna-define-method elmo-folder-append-messages ((folder elmo-pipe-folder) src-folder numbers - unread-marks &optional same-number) (elmo-folder-append-messages (elmo-pipe-folder-dst-internal folder) src-folder numbers - unread-marks same-number)) (luna-define-method elmo-folder-append-buffer ((folder elmo-pipe-folder) - unread &optional number) + &optional flag number) (elmo-folder-append-buffer (elmo-pipe-folder-dst-internal folder) - unread number)) + flag number)) (luna-define-method elmo-message-fetch ((folder elmo-pipe-folder) number strategy @@ -135,8 +126,6 @@ (when (and copy msgs) (setq ignore-list (elmo-number-set-append-list ignore-list msgs))) - ;; Don't save msgdb here. - ;; Because summary view of original folder is not updated yet. (elmo-folder-close-internal src) (run-hooks 'elmo-pipe-drained-hook) ignore-list)) @@ -160,37 +149,25 @@ copied-list)) (luna-define-method elmo-folder-open-internal ((folder elmo-pipe-folder)) - (elmo-folder-open-internal (elmo-pipe-folder-dst-internal folder)) - (let ((src-folder (elmo-pipe-folder-src-internal folder)) - (dst-folder (elmo-pipe-folder-dst-internal folder))) - (when (and (elmo-folder-plugged-p src-folder) - (elmo-folder-plugged-p dst-folder)) - (if (elmo-pipe-folder-copy-internal folder) - (elmo-pipe-folder-copied-list-save - folder - (elmo-pipe-drain src-folder - dst-folder - 'copy - (elmo-pipe-folder-copied-list-load folder))) - (elmo-pipe-drain src-folder dst-folder))))) + (elmo-folder-open-internal (elmo-pipe-folder-dst-internal folder))) (luna-define-method elmo-folder-close-internal ((folder elmo-pipe-folder)) (elmo-folder-close-internal(elmo-pipe-folder-dst-internal folder))) -(luna-define-method elmo-folder-list-messages-internal - ((folder elmo-pipe-folder) &optional nohide) - (elmo-folder-list-messages-internal (elmo-pipe-folder-dst-internal - folder) nohide)) +(luna-define-method elmo-folder-list-messages ((folder elmo-pipe-folder) + &optional visible-only in-msgdb) + ;; Use target folder's killed-list in the pipe folder. + (elmo-folder-list-messages (elmo-pipe-folder-dst-internal + folder) visible-only in-msgdb)) + +(luna-define-method elmo-folder-list-unreads ((folder elmo-pipe-folder)) + (elmo-folder-list-unreads (elmo-pipe-folder-dst-internal folder))) -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-pipe-folder) unread-marks &optional mark-alist) - (elmo-folder-list-unreads-internal (elmo-pipe-folder-dst-internal folder) - unread-marks mark-alist)) +(luna-define-method elmo-folder-list-importants ((folder elmo-pipe-folder)) + (elmo-folder-list-importants (elmo-pipe-folder-dst-internal folder))) -(luna-define-method elmo-folder-list-importants-internal - ((folder elmo-pipe-folder) important-mark) - (elmo-folder-list-importants-internal (elmo-pipe-folder-dst-internal folder) - important-mark)) +(luna-define-method elmo-folder-list-answereds ((folder elmo-pipe-folder)) + (elmo-folder-list-answereds (elmo-pipe-folder-dst-internal folder))) (luna-define-method elmo-folder-status ((folder elmo-pipe-folder)) (elmo-folder-open-internal (elmo-pipe-folder-src-internal folder)) @@ -248,8 +225,7 @@ (elmo-message-use-cache-p (elmo-pipe-folder-dst-internal folder) number)) (luna-define-method elmo-folder-check ((folder elmo-pipe-folder)) - (elmo-folder-close-internal folder) - (elmo-folder-open-internal folder)) + (elmo-folder-check (elmo-pipe-folder-dst-internal folder))) (luna-define-method elmo-folder-plugged-p ((folder elmo-pipe-folder)) (and (elmo-folder-plugged-p (elmo-pipe-folder-src-internal folder)) @@ -287,24 +263,37 @@ (elmo-pipe-folder-dst-internal folder) numbers start-number)) (luna-define-method elmo-folder-mark-as-read ((folder elmo-pipe-folder) - numbers) + numbers &optional ignore-flag) (elmo-folder-mark-as-read (elmo-pipe-folder-dst-internal folder) - numbers)) + numbers ignore-flag)) (luna-define-method elmo-folder-unmark-read ((folder elmo-pipe-folder) - numbers) + numbers + &optional ignore-flag) (elmo-folder-unmark-read (elmo-pipe-folder-dst-internal folder) - numbers)) + numbers ignore-flag)) (luna-define-method elmo-folder-unmark-important ((folder elmo-pipe-folder) - numbers) + numbers + &optional ignore-flag) (elmo-folder-unmark-important (elmo-pipe-folder-dst-internal folder) - numbers)) + numbers ignore-flag)) (luna-define-method elmo-folder-mark-as-important ((folder elmo-pipe-folder) - numbers) + numbers + &optional ignore-flag) (elmo-folder-mark-as-important (elmo-pipe-folder-dst-internal folder) - numbers)) + numbers ignore-flag)) + +(luna-define-method elmo-folder-unmark-answered ((folder elmo-pipe-folder) + numbers) + (elmo-folder-unmark-answered (elmo-pipe-folder-dst-internal folder) + numbers)) + +(luna-define-method elmo-folder-mark-as-answered ((folder elmo-pipe-folder) + numbers) + (elmo-folder-mark-as-answered (elmo-pipe-folder-dst-internal folder) + numbers)) (luna-define-method elmo-folder-pack-numbers ((folder elmo-pipe-folder)) (elmo-folder-pack-numbers (elmo-pipe-folder-dst-internal folder))) @@ -331,6 +320,59 @@ (elmo-pipe-folder-dst-internal new-folder)) (elmo-msgdb-rename-path folder new-folder))) +(luna-define-method elmo-folder-commit ((folder elmo-pipe-folder)) + (elmo-folder-commit + (elmo-pipe-folder-dst-internal folder))) + +(luna-define-method elmo-folder-synchronize ((folder elmo-pipe-folder) + &optional ignore-msgdb + no-check) + (let ((src-folder (elmo-pipe-folder-src-internal folder)) + (dst-folder (elmo-pipe-folder-dst-internal folder))) + (when (and (elmo-folder-plugged-p src-folder) + (elmo-folder-plugged-p dst-folder)) + (if (elmo-pipe-folder-copy-internal folder) + (elmo-pipe-folder-copied-list-save + folder + (elmo-pipe-drain src-folder + dst-folder + 'copy + (elmo-pipe-folder-copied-list-load folder))) + (elmo-pipe-drain src-folder dst-folder)))) + (elmo-folder-synchronize + (elmo-pipe-folder-dst-internal folder) ignore-msgdb no-check)) + +(luna-define-method elmo-folder-list-flagged ((folder elmo-pipe-folder) + flag + &optional in-msgdb) + (elmo-folder-list-flagged + (elmo-pipe-folder-dst-internal folder) flag in-msgdb)) + +(luna-define-method elmo-folder-commit ((folder elmo-pipe-folder)) + (elmo-folder-commit (elmo-pipe-folder-dst-internal folder))) + +(luna-define-method elmo-folder-length ((folder elmo-pipe-folder)) + (elmo-folder-length (elmo-pipe-folder-dst-internal folder))) + +(luna-define-method elmo-folder-count-flags ((folder elmo-pipe-folder)) + (elmo-folder-count-flags (elmo-pipe-folder-dst-internal folder))) + +(luna-define-method elmo-message-mark ((folder elmo-pipe-folder) number) + (elmo-message-mark (elmo-pipe-folder-dst-internal folder) number)) + +(luna-define-method elmo-message-field ((folder elmo-pipe-folder) + number field) + (elmo-message-field (elmo-pipe-folder-dst-internal folder) + number + field)) + +(luna-define-method elmo-message-entity ((folder elmo-pipe-folder) key) + (elmo-message-entity (elmo-pipe-folder-dst-internal folder) key)) + +(luna-define-method elmo-message-folder ((folder elmo-multi-folder) + number) + (elmo-pipe-folder-dst-internal folder)) + (require 'product) (product-provide (provide 'elmo-pipe) (require 'elmo-version)) diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index d594e93..201c670 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -56,7 +56,11 @@ If server doesn't accept asynchronous commands, this variable should be set as non-nil.") -(defvar elmo-pop3-exists-exactly t) +(defcustom elmo-pop3-exists-exactly nil + "If non-nil, POP3 folder existence is checked everytime before the session." + :type 'boolean + :group 'elmo) + (defvar sasl-mechanism-alist) (defvar elmo-pop3-total-size nil) @@ -168,19 +172,23 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." nil (elmo-pop3-folder-use-uidl-internal folder)))) - (if (eq if-exists 'any-exists) - (or (elmo-network-get-session 'elmo-pop3-session - "POP3" - folder if-exists) - (elmo-network-get-session 'elmo-pop3-session - "BIFF-POP3" - folder if-exists)) - (elmo-network-get-session 'elmo-pop3-session - (concat - (if (elmo-folder-biff-internal folder) - "BIFF-") - "POP3") - folder if-exists)))) + (prog1 + (if (eq if-exists 'any-exists) + (or (elmo-network-get-session 'elmo-pop3-session + "POP3" + folder if-exists) + (elmo-network-get-session 'elmo-pop3-session + "BIFF-POP3" + folder if-exists)) + (elmo-network-get-session 'elmo-pop3-session + (concat + (if (elmo-folder-biff-internal folder) + "BIFF-") + "POP3") + folder if-exists)) + ;; For saving existency. + (unless (file-exists-p (elmo-folder-msgdb-path folder)) + (elmo-make-directory (elmo-folder-msgdb-path folder)))))) (defun elmo-pop3-send-command (process command &optional no-erase no-log) (with-current-buffer (process-buffer process) @@ -469,7 +477,11 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (setq session (elmo-pop3-get-session folder)) (if session (elmo-network-close-session session))))) - (file-directory-p (elmo-folder-msgdb-path folder)))) + (or (file-directory-p (elmo-folder-msgdb-path folder)) + ;; First time. + (when (elmo-folder-plugged-p folder) + (let ((elmo-pop3-exists-exactly t)) + (elmo-folder-exists-p folder)))))) (defun elmo-pop3-parse-uidl-response (string) (let ((buffer (current-buffer)) @@ -677,9 +689,7 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (copy-to-buffer tobuffer (point-min) (point-max))))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-pop3-folder) - numlist new-mark - already-mark seen-mark - important-mark seen-list) + numlist flag-table) (let ((process (elmo-network-session-process-internal (elmo-pop3-get-session folder)))) (with-current-buffer (process-buffer process) @@ -688,8 +698,7 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (elmo-pop3-msgdb-create-by-header process numlist - new-mark already-mark - seen-mark seen-list + flag-table (if (elmo-pop3-folder-use-uidl-internal folder) (elmo-pop3-folder-location-alist-internal folder))))))) @@ -727,9 +736,7 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." elmo-pop3-size-hash)) (defun elmo-pop3-msgdb-create-by-header (process numlist - new-mark already-mark - seen-mark - seen-list + flag-table loc-alist) (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*"))) (with-current-buffer (process-buffer process) @@ -749,15 +756,14 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." process (length numlist) numlist - new-mark already-mark seen-mark seen-list loc-alist) + flag-table loc-alist) (kill-buffer tmp-buffer))))) (defun elmo-pop3-msgdb-create-message (buffer process num - numlist new-mark already-mark - seen-mark - seen-list + numlist + flag-table loc-alist) (save-excursion (let (beg overview number-alist mark-alist @@ -801,17 +807,12 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (elmo-msgdb-overview-entity-get-number entity) (car entity))) (setq message-id (car entity)) - (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - (if elmo-pop3-use-cache - seen-mark) - new-mark)))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist diff --git a/elmo/elmo-sendlog.el b/elmo/elmo-sendlog.el index 3cf0bc5..c8cbbc4 100644 --- a/elmo/elmo-sendlog.el +++ b/elmo/elmo-sendlog.el @@ -81,10 +81,7 @@ (elmo-map-message-location folder number))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-sendlog-folder) - numbers new-mark - already-mark seen-mark - important-mark - seen-list) + numbers flag-table) (let ((i 0) (len (length numbers)) overview number-alist mark-alist entity message-id @@ -110,7 +107,11 @@ num message-id)) (if (setq mark (or (elmo-msgdb-global-mark-get message-id) - (if (member message-id seen-list) nil new-mark))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist @@ -152,27 +153,6 @@ (luna-define-method elmo-message-file-p ((folder elmo-sendlog-folder) number) t) -;;; To override elmo-map-folder methods. -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-sendlog-folder) unread-marks &optional mark-alist) - t) - -(luna-define-method elmo-folder-unmark-important ((folder elmo-sendlog-folder) - numbers) - t) - -(luna-define-method elmo-folder-mark-as-important ((folder elmo-sendlog-folder) - numbers) - t) - -(luna-define-method elmo-folder-unmark-read ((folder elmo-sendlog-folder) - numbers) - t) - -(luna-define-method elmo-folder-mark-as-read ((folder elmo-sendlog-folder) - numbers) - t) - (require 'product) (product-provide (provide 'elmo-sendlog) (require 'elmo-version)) diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index 0ab51fe..3f3b792 100644 --- a/elmo/elmo-shimbun.el +++ b/elmo/elmo-shimbun.el @@ -349,10 +349,7 @@ update overview when message is fetched." (list (cons "xref" (shimbun-header-xref header))))))))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder) - numlist new-mark - already-mark seen-mark - important-mark - seen-list) + numlist flag-table) (let* (overview number-alist mark-alist entity i percent number length pair msgid gmark seen) (setq length (length numlist)) @@ -371,15 +368,12 @@ update overview when message is fetched." (setq number-alist (elmo-msgdb-number-add number-alist number msgid)) - (setq seen (member msgid seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get msgid) - (if (elmo-file-cache-status - (elmo-file-cache-get msgid)) - (if seen nil already-mark) - (if seen - (if elmo-shimbun-use-cache - seen-mark) - new-mark)))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table msgid) + (elmo-file-cache-status + (elmo-file-cache-get msgid)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist number gmark)))) @@ -539,27 +533,6 @@ update overview when message is fetched." folder)))) t)) -;;; To override elmo-map-folder methods. -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-shimbun-folder) unread-marks &optional mark-alist) - t) - -(luna-define-method elmo-folder-unmark-important ((folder elmo-shimbun-folder) - numbers) - t) - -(luna-define-method elmo-folder-mark-as-important ((folder elmo-shimbun-folder) - numbers) - t) - -(luna-define-method elmo-folder-unmark-read ((folder elmo-shimbun-folder) - numbers) - t) - -(luna-define-method elmo-folder-mark-as-read ((folder elmo-shimbun-folder) - numbers) - t) - (require 'product) (product-provide (provide 'elmo-shimbun) (require 'elmo-version)) diff --git a/elmo/elmo-split.el b/elmo/elmo-split.el index 03a975e..db175a4 100644 --- a/elmo/elmo-split.el +++ b/elmo/elmo-split.el @@ -294,6 +294,7 @@ If prefix argument ARG is specified, do a reharsal (no harm)." (elmo-message-fetch folder msg (elmo-make-fetch-strategy 'entire) nil (current-buffer) 'unread)) + (run-hooks 'elmo-split-fetch-hook) (setq elmo-split-message-entity (mime-parse-buffer)) (catch 'terminate (dolist (rule (append elmo-split-rule default-rule)) @@ -326,7 +327,7 @@ If prefix argument ARG is specified, do a reharsal (no harm)." action))) (elmo-folder-create target-folder))) (elmo-folder-open-internal target-folder) - (elmo-folder-append-buffer target-folder 'unread) + (elmo-folder-append-buffer target-folder) (elmo-folder-close-internal target-folder)) (error (setq failure t) (incf fcount))) @@ -370,7 +371,7 @@ If prefix argument ARG is specified, do a reharsal (no harm)." " Test: do nothing\n") ((function action) (format " Test: function:%s\n" - (symbol-name action))) + (prin1-to-string action))) (t " ERROR: wrong action specified\n")) (cond diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 59fb3f8..413aaa9 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -149,7 +149,7 @@ File content is encoded with MIME-CHARSET." (format "%s (%s): " prompt default) (mapcar 'list (append '("AND" "OR" - "Last" "First" + "Last" "First" "Flag" "From" "Subject" "To" "Cc" "Body" "Since" "Before" "ToCc" "!From" "!Subject" "!To" "!Cc" "!Body" @@ -178,6 +178,15 @@ File content is encoded with MIME-CHARSET." elmo-date-descriptions))) (concat (downcase field) ":" (if (equal value "") default value)))) + ((string= field "Flag") + (setq value (completing-read + (format "Value for '%s': " field) + (mapcar 'list + '("unread" "important" "answered" "digest" "any")))) + (unless (string-match (concat "^" elmo-condition-atom-regexp "$") + value) + (setq value (prin1-to-string value))) + (concat (downcase field) ":" value)) (t (setq value (read-from-minibuffer (format "Value for '%s': " field))) (unless (string-match (concat "^" elmo-condition-atom-regexp "$") @@ -233,7 +242,7 @@ Return value is a cons cell of (STRUCTURE . REST)" (goto-char (match-end 0)))) ;; search-key ::= [A-Za-z-]+ ;; ;; "since" / "before" / "last" / "first" / -;; ;; "body" / field-name +;; ;; "body" / "mark" / field-name ((looking-at "\\(!\\)? *\\([A-Za-z-]+\\) *: *") (goto-char (match-end 0)) (let ((search-key (vector @@ -948,6 +957,7 @@ the directory becomes empty after deletion." (defmacro elmo-get-hash-val (string hashtable) `(and (stringp ,string) + ,hashtable (let ((sym (intern-soft ,string ,hashtable))) (if (boundp sym) (symbol-value sym))))) @@ -1264,7 +1274,6 @@ But if optional argument AUTO is non-nil, DEFAULT is returned." (y-or-n-p prompt))) (defun elmo-string-member (string slist) - "Return t if STRING is a member of the SLIST." (catch 'found (while slist (if (and (stringp (car slist)) @@ -1657,6 +1666,7 @@ If the cache is partial file-cache, TYPE is 'partial." (nth (% (/ sum 16) 2) chars) (nth (% sum 16) chars)))) +;;; (defun elmo-file-cache-get-path (msgid &optional section) "Get cache path for MSGID. If optional argument SECTION is specified, partial cache path is returned." @@ -2012,6 +2022,18 @@ If ALIST is nil, `elmo-obsolete-variable-alist' is used." elmo-msgdb-directory) elmo-dop-queue)) +(if (and (fboundp 'regexp-opt) + (not (featurep 'xemacs))) + (defalias 'elmo-regexp-opt 'regexp-opt) + (defun elmo-regexp-opt (strings &optional paren) + "Return a regexp to match a string in STRINGS. +Each string should be unique in STRINGS and should not contain any regexps, +quoted or not. If optional PAREN is non-nil, ensure that the returned regexp +is enclosed by at least one regexp grouping construct." + (let ((open-paren (if paren "\\(" "")) (close-paren (if paren "\\)" ""))) + (concat open-paren (mapconcat 'regexp-quote strings "\\|") + close-paren)))) + (require 'product) (product-provide (provide 'elmo-util) (require 'elmo-version)) diff --git a/elmo/elmo.el b/elmo/elmo.el index c1cb796..7392cdb 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -124,8 +124,7 @@ If a folder name begins with PREFIX, use BACKEND." ;;;###autoload (defun elmo-make-folder (name &optional non-persistent) "Make an ELMO folder structure specified by NAME. -If optional argument NON-PERSISTENT is non-nil, folder is treated as - non-persistent." +If optional argument NON-PERSISTENT is non-nil, the folder msgdb is not saved." (let ((type (elmo-folder-type name)) prefix split class folder original) (setq original (elmo-string name)) @@ -141,19 +140,22 @@ If optional argument NON-PERSISTENT is non-nil, folder is treated as (setq class (format "elmo-%s" (symbol-name type))) (require (intern class)) (setq folder (luna-make-entity (intern (concat class "-folder")) - :type type + :type type :prefix prefix :name original :persistent (not non-persistent))) (save-match-data (elmo-folder-send folder 'elmo-folder-initialize name)))) -(defmacro elmo-folder-msgdb (folder) - "Return the msgdb of FOLDER (on-demand loading)." - (` (or (elmo-folder-msgdb-internal (, folder)) - (elmo-folder-set-msgdb-internal (, folder) - (elmo-msgdb-load (, folder)))))) +;; Note that this function is for internal use only. +(luna-define-generic elmo-folder-msgdb (folder) + "Return the msgdb of FOLDER (on-demand loading). +\(For internal use only.\)") +(luna-define-method elmo-folder-msgdb ((folder elmo-folder)) + (or (elmo-folder-msgdb-internal folder) + (elmo-folder-set-msgdb-internal folder + (elmo-msgdb-load folder)))) (luna-define-generic elmo-folder-open (folder &optional load-msgdb) "Open and setup (load saved status) FOLDER. If optional LOAD-MSGDB is non-nil, msgdb is loaded. @@ -195,8 +197,8 @@ If optional KEEP-KILLED is non-nil, killed-list is not cleared.") If optional NUMBERS is set, it is used as current NUMBERS. Otherwise, saved status for folder is used for comparison. Return value is cons cell or list: - - a cons cell (NEWS . MESSAGES) - - a list (RECENT UNSEEN MESSAGES) ; RECENT means NEWS, UNSEEN means UNREAD.") + - a cons cell (new . all) + - a list (new unread all)") (luna-define-generic elmo-folder-status (folder) "Returns a cons cell of (MAX-NUMBER . MESSAGES) in the FOLDER.") @@ -204,56 +206,75 @@ Return value is cons cell or list: (luna-define-generic elmo-folder-reserve-status-p (folder) "If non-nil, the folder should not close folder after `elmo-folder-status'.") -(defun elmo-folder-list-messages (folder &optional visible-only) +(luna-define-generic elmo-folder-list-messages (folder &optional visible-only + in-msgdb) "Return a list of message numbers contained in FOLDER. -If optional VISIBLE-ONLY is non-nil, killed messages are not listed." - (let ((list (elmo-folder-list-messages-internal folder visible-only)) - (killed (elmo-folder-killed-list-internal folder)) - numbers) - (setq numbers - (if (listp list) - list - ;; Not available, use current list. - (mapcar - 'car - (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder))))) - (elmo-living-messages numbers killed))) - -(defun elmo-folder-list-unreads (folder unread-marks) - "Return a list of unread message numbers contained in FOLDER. -UNREAD-MARKS is the unread marks." - (let ((list (elmo-folder-list-unreads-internal folder - unread-marks))) - (if (listp list) - list - ;; Not available, use current mark. - (delq nil - (mapcar - (function - (lambda (x) - (if (member (cadr x) unread-marks) - (car x)))) - (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))))))) - -(defun elmo-folder-list-importants (folder important-mark) - "Returns a list of important message numbers contained in FOLDER. -IMPORTANT-MARK is the important mark." - (let ((importants (elmo-folder-list-importants-internal folder important-mark)) - (number-alist (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder))) - num-pair result) +If optional VISIBLE-ONLY is non-nil, killed messages are not listed. +If second optional IN-MSGDB is non-nil, only messages in the msgdb are listed.") +(luna-define-method elmo-folder-list-messages ((folder elmo-folder) + &optional visible-only in-msgdb) + (let ((list (if in-msgdb + t + (elmo-folder-list-messages-internal folder visible-only)))) + (elmo-living-messages + (if (listp list) + list + ;; Use current list. + (elmo-msgdb-list-messages (elmo-folder-msgdb folder))) + (elmo-folder-killed-list-internal folder)))) + +(luna-define-generic elmo-folder-list-unreads (folder) + "Return a list of unread message numbers contained in FOLDER.") +(luna-define-generic elmo-folder-list-importants (folder) + "Return a list of important message numbers contained in FOLDER.") +(luna-define-generic elmo-folder-list-answereds (folder) + "Return a list of answered message numbers contained in FOLDER.") + +;; TODO: Should reconsider the structure of global mark. +(defun elmo-folder-list-messages-with-global-mark (folder mark) + (let (entity msgs) (dolist (mark-pair (or elmo-msgdb-global-mark-alist (setq elmo-msgdb-global-mark-alist (elmo-object-load (expand-file-name elmo-msgdb-global-mark-filename elmo-msgdb-directory))))) - (if (and (string= important-mark (cdr mark-pair)) - (setq num-pair (rassoc (car mark-pair) number-alist))) - (setq result (cons (car num-pair) result)))) - (if (listp importants) - (elmo-uniq-list (nconc result importants)) - result))) + (if (and (string= mark (cdr mark-pair)) + (setq entity + (elmo-msgdb-overview-get-entity (car mark-pair) + (elmo-folder-msgdb + folder)))) + (setq msgs (cons (elmo-msgdb-overview-entity-get-number entity) + msgs)))) + msgs)) + +(luna-define-generic elmo-folder-list-flagged (folder flag &optional in-msgdb) + "List messages in the FOLDER with FLAG. +FLAG is a symbol which is one of the following: + `new' (new messages) + `unread' (unread messages (new messages are included)) + `answered' (answered or forwarded) + `important' (marked as important) +'sugar' flags: + `read' (not unread) + `digest' (unread + important) + `any' (digest + answered) + +If optional IN-MSGDB is non-nil, retrieve flag information from msgdb.") + +(luna-define-method elmo-folder-list-flagged ((folder elmo-folder) flag + &optional in-msgdb) + ;; Currently, only in-msgdb is implemented. + (elmo-msgdb-list-flagged (elmo-folder-msgdb folder) flag)) + +(luna-define-method elmo-folder-list-unreads ((folder elmo-folder)) + (elmo-folder-list-flagged folder 'unread)) + +(luna-define-method elmo-folder-list-importants ((folder elmo-folder)) + (elmo-folder-list-flagged folder 'important)) + +(luna-define-method elmo-folder-list-answereds ((folder elmo-folder)) + (elmo-folder-list-flagged folder 'answered)) (luna-define-generic elmo-folder-list-messages-internal (folder &optional visible-only) @@ -261,20 +282,6 @@ IMPORTANT-MARK is the important mark." ;; Return t if the message list is not available. ) -(luna-define-generic elmo-folder-list-unreads-internal (folder - unread-marks - &optional mark-alist) - ;; Return a list of unread message numbers contained in FOLDER. - ;; If optional MARK-ALIST is set, it is used as mark-alist. - ;; Return t if this feature is not available. - ) - -(luna-define-generic elmo-folder-list-importants-internal (folder - important-mark) - ;; Return a list of important message numbers contained in FOLDER. - ;; Return t if this feature is not available. - ) - (luna-define-generic elmo-folder-list-subfolders (folder &optional one-level) "Returns a list of subfolders contained in FOLDER. If optional argument ONE-LEVEL is non-nil, only children of FOLDER is returned. @@ -328,46 +335,63 @@ CONDITION is a condition structure for testing. NUMBERS is a list of message numbers, use to be test for \"last\" and \"first\" predicates.") -(luna-define-generic elmo-folder-msgdb-create - (folder numbers new-mark already-mark seen-mark important-mark seen-list) +(luna-define-generic elmo-folder-msgdb-create (folder numbers flag-table) "Create a message database (implemented in each backends). FOLDER is the ELMO folder structure. NUMBERS is a list of message numbers to create msgdb. -NEW-MARK, ALREADY-MARK, SEEN-MARK, and IMPORTANT-MARK are mark string for -new message, unread but cached message, read message and important message. -SEEN-LIST is a list of message-id string which should be treated as read.") +FLAG-TABLE is a hashtable of message-id and flag.") -(luna-define-generic elmo-folder-unmark-important (folder numbers) +(luna-define-generic elmo-folder-unmark-important (folder + numbers + &optional ignore-flags) "Un-mark messages as important. FOLDER is the ELMO folder structure. -NUMBERS is a list of message numbers to be processed.") +NUMBERS is a list of message numbers to be processed. +If IGNORE-FLAGS is non-nil, folder flags are not updated.") -(luna-define-generic elmo-folder-mark-as-important (folder numbers) +(luna-define-generic elmo-folder-mark-as-important (folder + numbers + &optional ignore-flags) "Mark messages as important. FOLDER is the ELMO folder structure. -NUMBERS is a list of message numbers to be processed.") +NUMBERS is a list of message numbers to be processed. +If IGNORE-FLAGS is non-nil, folder flags are not updated.") -(luna-define-generic elmo-folder-unmark-read (folder numbers) +(luna-define-generic elmo-folder-unmark-read (folder numbers + &optional ignore-flags) "Un-mark messages as read. FOLDER is the ELMO folder structure. -NUMBERS is a list of message numbers to be processed.") +NUMBERS is a list of message numbers to be processed. +If IGNORE-FLAGS is non-nil, folder flags are not updated.") -(luna-define-generic elmo-folder-mark-as-read (folder numbers) +(luna-define-generic elmo-folder-mark-as-read (folder numbers + &optional ignore-flags) "Mark messages as read. FOLDER is the ELMO folder structure. +NUMBERS is a list of message numbers to be processed. +If IGNORE-FLAGS is non-nil, folder flags are not updated.") + +(luna-define-generic elmo-folder-unmark-answered (folder numbers) + "Un-mark messages as answered. +FOLDER is the ELMO folder structure. NUMBERS is a list of message numbers to be processed.") -(luna-define-generic elmo-folder-append-buffer (folder unread &optional number) +(luna-define-generic elmo-folder-mark-as-answered (folder numbers) + "Mark messages as answered. +FOLDER is the ELMO folder structure. +NUMBERS is a list of message numbers to be processed.") + +(luna-define-generic elmo-folder-append-buffer (folder &optional flag + number) "Append current buffer as a new message. FOLDER is the destination folder(ELMO folder structure). -If UNREAD is non-nil, message is appended as unread. +FLAG is the status of appended message. If optional argument NUMBER is specified, the new message number is set \(if possible\).") (luna-define-generic elmo-folder-append-messages (folder src-folder numbers - unread-marks &optional same-number) "Append messages from folder. @@ -376,7 +400,6 @@ Caller should make sure FOLDER is `writable'. (Can be checked with `elmo-folder-writable-p'). SRC-FOLDER is the source ELMO folder structure. NUMBERS is the message numbers to be appended in the SRC-FOLDER. -UNREAD-MARKS is a list of unread mark string. If second optional argument SAME-NUMBER is specified, message number is preserved (if possible).") @@ -521,14 +544,6 @@ Return newly created temporary directory name which contains temporary files.") ((folder elmo-folder) &optional visible-only) t) -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-folder) unread-marks &optional mark-alist) - t) - -(luna-define-method elmo-folder-list-importants-internal - ((folder elmo-folder) important-mark) - t) - (defun elmo-folder-encache (folder numbers &optional unread) "Encache messages in the FOLDER with NUMBERS. If UNREAD is non-nil, messages are not marked as read." @@ -603,9 +618,7 @@ FIELD is a symbol of the field name.") (luna-define-generic elmo-message-folder (folder number) "Get primitive folder of the message.") -(luna-define-generic elmo-folder-process-crosspost (folder - &optional - number-alist) +(luna-define-generic elmo-folder-process-crosspost (folder) "Process crosspost for FOLDER. If NUMBER-ALIST is set, it is used as number-alist. Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") @@ -616,6 +629,22 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (luna-define-generic elmo-folder-newsgroups (folder) "Return list of newsgroup name of FOLDER.") +(luna-define-generic elmo-folder-search-requires-msgdb-p (folder condition) + "Return non-nil if searching in FOLDER by CONDITION requires msgdb fetch.") + +(defun elmo-folder-search-requires-msgdb-p-internal (folder condition) + (if (listp condition) + (or (elmo-folder-search-requires-msgdb-p-internal + folder (nth 1 condition)) + (elmo-folder-search-requires-msgdb-p-internal + folder (nth 2 condition))) + (and (not (string= (elmo-filter-key condition) "last")) + (not (string= (elmo-filter-key condition) "first"))))) + +(luna-define-method elmo-folder-search-requires-msgdb-p ((folder elmo-folder) + condition) + (elmo-folder-search-requires-msgdb-p-internal folder condition)) + (luna-define-method elmo-folder-newsgroups ((folder elmo-folder)) nil) @@ -625,8 +654,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (defun elmo-generic-folder-open (folder load-msgdb) (let ((inhibit-quit t)) - (if load-msgdb - (elmo-folder-set-msgdb-internal folder (elmo-msgdb-load folder))) + (if load-msgdb (elmo-folder-msgdb folder)) (elmo-folder-set-killed-list-internal folder (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))) @@ -714,60 +742,84 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (elmo-folder-send folder 'elmo-folder-rename-internal new-folder) (elmo-msgdb-rename-path folder new-folder))) -(luna-define-method elmo-folder-rename-internal ((folder elmo-folder) - new-folder) - (error "Cannot rename %s folder" - (symbol-name (elmo-folder-type-internal folder)))) - (defsubst elmo-folder-search-fast (folder condition numbers) - (when (and numbers - (vectorp condition) - (member (elmo-filter-key condition) '("first" "last"))) - (let ((len (length numbers)) - (lastp (string= (elmo-filter-key condition) "last")) - (value (string-to-number (elmo-filter-value condition)))) - (when (eq (elmo-filter-type condition) 'unmatch) - (setq lastp (not lastp) - value (- len value))) - (if lastp - (nthcdr (max (- len value) 0) numbers) - (when (> value 0) - (let ((last (nthcdr (1- value) numbers))) - (when last - (setcdr last nil)) - numbers)))))) + "Search and return list of message numbers. +Return t if CONDITION is not treated. +FOLDER is the ELMO folder structure. +CONDITION is a condition structure for searching. +NUMBERS is a list of message numbers, messages are searched from the list." + (if (and numbers + (vectorp condition)) + (cond + ((string= (elmo-filter-key condition) "flag") + (let ((msgdb (elmo-folder-msgdb folder))) + ;; msgdb should be synchronized at this point. + (cond + ((string= (elmo-filter-value condition) "unread") + (elmo-folder-list-unreads folder)) + ((string= (elmo-filter-value condition) "important") + (elmo-folder-list-importants folder)) + ((string= (elmo-filter-value condition) "answered") + (elmo-folder-list-answereds folder)) + ((string= (elmo-filter-value condition) "digest") + (nconc (elmo-folder-list-unreads folder) + (elmo-folder-list-importants folder))) + ((string= (elmo-filter-value condition) "any") + (nconc (elmo-folder-list-unreads folder) + (elmo-folder-list-importants folder) + (elmo-folder-list-answereds folder)))))) + ((member (elmo-filter-key condition) '("first" "last")) + (let ((len (length numbers)) + (lastp (string= (elmo-filter-key condition) "last")) + (value (string-to-number (elmo-filter-value condition)))) + (when (eq (elmo-filter-type condition) 'unmatch) + (setq lastp (not lastp) + value (- len value))) + (if lastp + (nthcdr (max (- len value) 0) numbers) + (when (> value 0) + (let* ((numbers (copy-sequence numbers)) + (last (nthcdr (1- value) numbers))) + (when last + (setcdr last nil)) + numbers))))) + (t + t)) + t)) (luna-define-method elmo-folder-search ((folder elmo-folder) condition &optional numbers) - (let ((numbers (or numbers (elmo-folder-list-messages folder)))) - (or (elmo-folder-search-fast folder condition numbers) - (let ((msgdb (elmo-folder-msgdb folder)) - (len (length numbers)) - matched) - (when (> len elmo-display-progress-threshold) - (elmo-progress-set 'elmo-folder-search len "Searching...")) - (unwind-protect - (dolist (number numbers) - (let ((entity (elmo-msgdb-overview-get-entity number msgdb)) - result) - (if entity - (setq result (elmo-msgdb-match-condition - condition - entity - numbers)) - (setq result condition)) - (when (elmo-filter-condition-p result) - (setq result (elmo-message-match-condition - folder - number - condition - numbers))) - (when result - (setq matched (cons number matched)))) - (elmo-progress-notify 'elmo-folder-search)) - (elmo-progress-clear 'elmo-folder-search)) - (nreverse matched))))) + (let ((numbers (or numbers (elmo-folder-list-messages folder))) + results) + (if (listp (setq results (elmo-folder-search-fast folder + condition + numbers))) + results + (let ((msgdb (elmo-folder-msgdb folder)) + (len (length numbers)) + matched) + (when (> len elmo-display-progress-threshold) + (elmo-progress-set 'elmo-folder-search len "Searching...")) + (unwind-protect + (dolist (number numbers) + (let (result) + (setq result (elmo-msgdb-match-condition + msgdb + condition + number + numbers)) + (when (elmo-filter-condition-p result) + (setq result (elmo-message-match-condition + folder + number + condition + numbers))) + (when result + (setq matched (cons number matched)))) + (elmo-progress-notify 'elmo-folder-search)) + (elmo-progress-clear 'elmo-folder-search)) + (nreverse matched))))) (luna-define-method elmo-message-match-condition ((folder elmo-folder) number condition @@ -932,11 +984,9 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") 0)) (elmo-folder-set-info-hashtb folder in-db-max nil)) (setq in-db-max cached-in-db-max))) - (setq unsync (if (and in-db - (car in-folder)) + (setq unsync (if (and in-db (car in-folder)) (- (car in-folder) in-db-max) - (if (and in-folder - (null in-db)) + (if (and in-folder (null in-db)) (cdr in-folder) (car in-folder)))) (setq messages (cdr in-folder)) @@ -962,19 +1012,28 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (luna-define-method elmo-folder-append-messages ((folder elmo-folder) src-folder numbers - unread-marks &optional same-number) (elmo-generic-folder-append-messages folder src-folder numbers - unread-marks same-number)) + same-number)) (defun elmo-generic-folder-append-messages (folder src-folder numbers - unread-marks same-number) - (let (unseen seen-list succeed-numbers failure cache) + same-number) + (let (unseen table flag mark + succeed-numbers failure cache) + (setq table (elmo-flag-table-load (elmo-folder-msgdb-path folder))) (with-temp-buffer (set-buffer-multibyte nil) (while numbers - (setq failure nil) + (setq failure nil + mark (elmo-message-mark src-folder (car numbers)) + flag (cond + ((null mark) nil) + ((member mark (elmo-msgdb-answered-marks)) + 'answered) + ;; + ((not (member mark (elmo-msgdb-unread-marks))) + 'read))) (condition-case nil (setq cache (elmo-file-cache-get (elmo-message-field src-folder @@ -1001,26 +1060,22 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (> (buffer-size) 0) (elmo-folder-append-buffer folder - (setq unseen (member (elmo-message-mark - src-folder (car numbers)) - unread-marks)) + flag (if same-number (car numbers)))))) (error (setq failure t))) ;; FETCH & APPEND finished (unless failure - (unless unseen - (setq seen-list (cons (elmo-message-field - src-folder (car numbers) - 'message-id) - seen-list))) + (when flag + (elmo-flag-table-set table + (elmo-message-field + src-folder (car numbers) + 'message-id) + flag)) (setq succeed-numbers (cons (car numbers) succeed-numbers))) (elmo-progress-notify 'elmo-folder-move-messages) (setq numbers (cdr numbers))) - (if (and seen-list (elmo-folder-persistent-p folder)) - (elmo-msgdb-seen-save (elmo-folder-msgdb-path folder) - (nconc (elmo-msgdb-seen-load - (elmo-folder-msgdb-path folder)) - seen-list))) + (when (elmo-folder-persistent-p folder) + (elmo-flag-table-save (elmo-folder-msgdb-path folder) table)) succeed-numbers))) ;; Arguments should be reduced. @@ -1029,7 +1084,6 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") no-delete-info no-delete same-number - unread-marks save-unread) (save-excursion (let* ((messages msgs) @@ -1047,39 +1101,22 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (unless (setq succeeds (elmo-folder-append-messages dst-folder src-folder messages - unread-marks same-number)) (error "move: append message to %s failed" (elmo-folder-name-internal dst-folder))) - (elmo-folder-close dst-folder)) - (when (and (elmo-folder-persistent-p dst-folder) - save-unread) - ;; Save to seen list. - (let* ((dir (elmo-folder-msgdb-path dst-folder)) - (seen-list (elmo-msgdb-seen-load dir))) - (setq seen-list - (elmo-msgdb-add-msgs-to-seen-list - msgs (elmo-folder-msgdb src-folder) - unread-marks seen-list)) - (elmo-msgdb-seen-save dir seen-list)))) + (elmo-folder-close dst-folder))) (if (and (not no-delete) succeeds) (progn - (if (not no-delete-info) - (message "Cleaning up src folder...")) (if (and (elmo-folder-delete-messages src-folder succeeds) - (elmo-msgdb-delete-msgs - (elmo-folder-msgdb src-folder) succeeds)) + (elmo-folder-detach-messages src-folder succeeds)) (setq result t) (message "move: delete messages from %s failed." (elmo-folder-name-internal src-folder)) (setq result nil)) - (if (and result - (not no-delete-info)) - (message "Cleaning up src folder...done")) result) (if no-delete (progn - (message "Copying messages...done") + ;; (message "Copying messages...done") t) (if (eq len 0) (message "No message was moved.") @@ -1094,34 +1131,140 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") folder (elmo-folder-expand-msgdb-path folder)))) -(defun elmo-message-mark (folder number) +(defun elmo-message-accessible-p (folder number) + "Get accessibility of the message. +Return non-nil when message is accessible." + (or (elmo-folder-plugged-p folder) + (elmo-folder-local-p folder) + (elmo-msgdb-get-cached (elmo-folder-msgdb folder) number))) + +(defun elmo-message-set-cached (folder number cached) + "Set cache status of the message in the msgdb. +FOLDER is the ELMO folder structure. +NUMBER is a number of the message. +If CACHED is t, message is set as cached." + (when (elmo-msgdb-set-cached (elmo-folder-msgdb folder) + number + cached + (elmo-message-use-cache-p folder number)) + (elmo-folder-set-mark-modified-internal folder t))) + +(defun elmo-message-copy-entity (entity) + ;; + (elmo-msgdb-copy-overview-entity entity)) + +(defun elmo-message-entity-set-number (entity number) + (elmo-msgdb-overview-entity-set-number entity number)) + +(luna-define-generic elmo-message-entity (folder key) + "Return the message-entity structure which matches to the KEY. +KEY is a number or a string. +A number is for message number in the FOLDER. +A string is for message-id of the message.") + +(luna-define-method elmo-message-entity ((folder elmo-folder) key) + (elmo-msgdb-message-entity (elmo-folder-msgdb folder) key)) + +(luna-define-generic elmo-message-entity-parent (folder entity) + "Return the parent message-entity structure in the FOLDER. +ENTITY is the message-entity to get the parent.") + +(luna-define-method elmo-message-entity-parent ((folder elmo-folder) entity) + (elmo-msgdb-get-parent-entity entity (elmo-folder-msgdb folder))) + +(put 'elmo-folder-do-each-message-entity 'lisp-indent-function '1) +(def-edebug-spec elmo-folder-do-each-message-entity + ((symbolp form &rest form) &rest form)) + +(defsubst elmo-folder-list-message-entities (folder) + ;; List all message entities in the FOLDER. + (mapcar + (lambda (number) (elmo-message-entity folder number)) + (elmo-folder-list-messages folder t t))) + +(defmacro elmo-folder-do-each-message-entity (spec &rest form) + "Iterator for message entity in the folder. +\(elmo-folder-do-each-message-entity \(entity folder\) + ... do the process using entity... +\)" + `(dolist (,(car spec) (elmo-folder-list-message-entities ,(car (cdr spec)))) + ,@form)) + +(defmacro elmo-message-entity-number (entity) + `(elmo-msgdb-overview-entity-get-number ,entity)) + +(defun elmo-message-entity-field (entity field &optional decode) + "Get message entity field value. +ENTITY is the message entity structure obtained by `elmo-message-entity'. +FIELD is the symbol of the field name. +if optional DECODE is non-nil, returned value is decoded." + (elmo-msgdb-message-entity-field entity field decode)) + +(defun elmo-message-entity-set-field (entity field value) + "Set message entity field value. +ENTITY is the message entity structure. +FIELD is the symbol of the field name. +VALUE is the field value (raw)." + (elmo-msgdb-message-entity-set-field entity field value)) + +(luna-define-generic elmo-folder-count-flags (folder) + "Count flagged message number in the msgdb of the FOLDER. +Return a list of numbers (`new' `unread' `answered')") + +(luna-define-method elmo-folder-count-flags ((folder elmo-folder)) + (let ((new 0) + (unreads 0) + (answered 0)) + (dolist (elem (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))) + (cond + ((string= (cadr elem) elmo-msgdb-new-mark) + (incf new)) + ((member (cadr elem) (elmo-msgdb-unread-marks)) + (incf unreads)) + ((member (cadr elem) (elmo-msgdb-answered-marks)) + (incf answered)))) + (list new unreads answered))) + +(defun elmo-message-set-flag (folder number flag) + "Set message flag. +FOLDER is a ELMO folder structure. +NUMBER is a message number to set flag. + +FLAG is a symbol which is one of the following: + `unread' (set the message as unread) + `answered' (set the message as answered) + `important' (set the message as important) +'sugar' flag: + `read' (remove new and unread flags)") + +(defun elmo-message-unset-flag (folder number flag) + "Unset message flag. +FOLDER is a ELMO folder structure. +NUMBER is a message number to set flag. + +FLAG is a symbol which is one of the following: + `unread' (remove unread and new flag) + `answered' (remove answered flag) + `important' (remove important flag) +'sugar' flag: + `read' (set unread flag)") + +(luna-define-generic elmo-message-mark (folder number) "Get mark of the message. FOLDER is the ELMO folder structure. -NUMBER is a number of the message." +NUMBER is a number of the message.") + +(luna-define-method elmo-message-mark ((folder elmo-folder) number) (elmo-msgdb-get-mark (elmo-folder-msgdb folder) number)) -(defun elmo-folder-list-messages-mark-match (folder mark-regexp) - "List messages in the FOLDER which have a mark that matches MARK-REGEXP" - (let ((case-fold-search nil) - matched) - (if mark-regexp - (dolist (elem (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))) - (if (string-match mark-regexp (cadr elem)) - (setq matched (cons (car elem) matched))))) - matched)) - -(defun elmo-message-field (folder number field) +(luna-define-generic elmo-message-field (folder number field) "Get message field value in the msgdb. FOLDER is the ELMO folder structure. NUMBER is a number of the message. -FIELD is a symbol of the field." - (elmo-msgdb-get-field (elmo-folder-msgdb folder) number field)) +FIELD is a symbol of the field.") -(defun elmo-message-set-mark (folder number mark) - "Set mark for the message in the FOLDER with NUMBER as MARK." - (elmo-msgdb-set-mark - (elmo-folder-msgdb folder) - number mark)) +(luna-define-method elmo-message-field ((folder elmo-folder) number field) + (elmo-msgdb-get-field (elmo-folder-msgdb folder) number field)) (luna-define-method elmo-message-use-cache-p ((folder elmo-folder) number) nil) ; default is not use cache. @@ -1129,37 +1272,70 @@ FIELD is a symbol of the field." (luna-define-method elmo-message-folder ((folder elmo-folder) number) folder) ; default is folder -(luna-define-method elmo-folder-unmark-important ((folder elmo-folder) numbers) - t) +(luna-define-method elmo-folder-unmark-important ((folder elmo-folder) + numbers + &optional ignore-flags) + (when (elmo-folder-msgdb-internal folder) + (dolist (number numbers) + (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) + folder + number + 'important)))) (luna-define-method elmo-folder-mark-as-important ((folder elmo-folder) - numbers) - t) - -(luna-define-method elmo-folder-unmark-read ((folder elmo-folder) numbers) - t) - -(luna-define-method elmo-folder-mark-as-read ((folder elmo-folder) numbers) - t) - -(luna-define-method elmo-folder-process-crosspost ((folder elmo-folder) - &optional - number-alist) + numbers + &optional ignore-flags) + (when (elmo-folder-msgdb-internal folder) + (dolist (number numbers) + (elmo-msgdb-set-flag (elmo-folder-msgdb folder) + folder + number + 'important)))) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-folder) + numbers + &optional ignore-flags) + (when (elmo-folder-msgdb-internal folder) + (dolist (number numbers) + (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) + folder + number + 'read)))) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-folder) + numbers + &optional ignore-flag) + (when (elmo-folder-msgdb-internal folder) + (dolist (number numbers) + (elmo-msgdb-set-flag (elmo-folder-msgdb folder) + folder + number + 'read)))) + +(luna-define-method elmo-folder-unmark-answered ((folder elmo-folder) numbers) + (when (elmo-folder-msgdb-internal folder) + (dolist (number numbers) + (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) + folder + number + 'answered)))) + +(luna-define-method elmo-folder-mark-as-answered ((folder elmo-folder) numbers) + (when (elmo-folder-msgdb-internal folder) + (dolist (number numbers) + (elmo-msgdb-set-flag (elmo-folder-msgdb folder) + folder + number + 'answered)))) + +(luna-define-method elmo-folder-process-crosspost ((folder elmo-folder)) ;; Do nothing. ) -(defsubst elmo-folder-replace-marks (folder alist) - "Replace marks of the FOLDER according to ALIST." - (let (pair) - (dolist (elem (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))) - (when (setq pair (assoc (cadr elem) alist)) - (if (elmo-message-use-cache-p folder (car elem)) - (elmo-msgdb-set-mark (elmo-folder-msgdb folder) - (car elem) - (cdr pair)) - (elmo-msgdb-set-mark (elmo-folder-msgdb folder) - (car elem) - nil)))))) +;;(luna-define-generic elmo-folder-append-message-entity (folder entity +;; &optional +;; flag-table) +;; "Append ENTITY to the folder.") (defun elmo-generic-folder-append-msgdb (folder append-msgdb) (if append-msgdb @@ -1172,6 +1348,10 @@ FIELD is a symbol of the field." pair overview to-be-deleted mark-alist) + (elmo-folder-set-msgdb-internal folder + (elmo-msgdb-append + (elmo-folder-msgdb folder) + append-msgdb)) (while cur (setq all-alist (delq (car cur) all-alist)) ;; same message id exists. @@ -1197,10 +1377,6 @@ FIELD is a symbol of the field." (t ;; Do nothing. (setq to-be-deleted nil))) - (elmo-folder-set-msgdb-internal folder - (elmo-msgdb-append - (elmo-folder-msgdb folder) - append-msgdb)) (length to-be-deleted)) 0)) @@ -1286,78 +1462,69 @@ FIELD is a symbol of the field." (or result (and err (signal (car err) (cdr err)))))) +(defun elmo-folder-kill-messages-before (folder msg) + (elmo-folder-set-killed-list-internal + folder + (list (cons 1 msg)))) + +(defun elmo-folder-kill-messages (folder numbers) + "Kill(hide) messages in the FOLDER with NUMBERS." + (elmo-folder-set-killed-list-internal + folder + (elmo-number-set-append-list (elmo-folder-killed-list-internal + folder) numbers))) + + (luna-define-method elmo-folder-clear ((folder elmo-folder) &optional keep-killed) (unless keep-killed (elmo-folder-set-killed-list-internal folder nil)) (elmo-folder-set-msgdb-internal folder (elmo-msgdb-clear))) -(defun elmo-folder-synchronize (folder - new-mark ;"N" - unread-uncached-mark ;"U" - unread-cached-mark ;"!" - read-uncached-mark ;"u" - important-mark ;"$" - &optional ignore-msgdb - no-check) +(luna-define-generic elmo-folder-synchronize (folder + &optional ignore-msgdb + no-check) "Synchronize the folder data to the newest status. FOLDER is the ELMO folder structure. -NEW-MARK, UNREAD-CACHED-MARK, READ-UNCACHED-MARK, and IMPORTANT-MARK -are mark strings for new messages, unread but cached messages, -read but not cached messages, and important messages. + If optional IGNORE-MSGDB is non-nil, current msgdb is thrown away except -read mark status. If IGNORE-MSGDB is 'visible-only, only visible messages +flag status. If IGNORE-MSGDB is 'visible-only, only visible messages \(the messages which are not in the killed-list\) are thrown away and synchronized. If NO-CHECK is non-nil, rechecking folder is skipped. +Return a list of a cross-posted message number. +If update process is interrupted, return nil.") -Return a list of -\(NEW-MSGDB DELETE-LIST CROSSED\) -NEW-MSGDB is the newly appended msgdb. -DELETE-LIST is a list of deleted message number. -CROSSED is cross-posted message number. -If update process is interrupted, return nil." +(luna-define-method elmo-folder-synchronize ((folder elmo-folder) + &optional ignore-msgdb no-check) (let ((killed-list (elmo-folder-killed-list-internal folder)) (before-append t) - number-alist mark-alist + number-alist old-msgdb diff diff-2 delete-list new-list new-msgdb mark - seen-list crossed after-append) + flag-table crossed after-append numbers) (setq old-msgdb (elmo-folder-msgdb folder)) - ;; Load seen-list. - (setq seen-list (elmo-msgdb-seen-load (elmo-folder-msgdb-path folder))) - (setq number-alist (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder))) - (setq mark-alist (elmo-msgdb-get-mark-alist - (elmo-folder-msgdb folder))) - (if ignore-msgdb - (progn - (setq seen-list (nconc - (elmo-msgdb-seen-list - (elmo-folder-msgdb folder) - (list important-mark read-uncached-mark)) - seen-list)) - (elmo-folder-clear folder (eq ignore-msgdb 'visible-only)))) + (setq flag-table (elmo-flag-table-load (elmo-folder-msgdb-path folder))) + (when ignore-msgdb + (elmo-msgdb-flag-table (elmo-folder-msgdb folder) flag-table) + (elmo-folder-clear folder (eq ignore-msgdb 'visible-only))) + (setq numbers (sort (elmo-folder-list-messages folder nil t) '<)) (unless no-check (elmo-folder-check folder)) (condition-case nil (progn (message "Checking folder diff...") - ;; TODO: killed list is loaded in elmo-folder-open and - ;; list-messages use internal killed-list-folder. (setq diff (elmo-list-diff (elmo-folder-list-messages folder (eq 'visible-only ignore-msgdb)) - (unless ignore-msgdb - (sort (mapcar - 'car - number-alist) - '<)))) + numbers)) (message "Checking folder diff...done") (setq new-list (elmo-folder-confirm-appends (car diff))) - ;; Set killed list. + ;; Set killed list as ((1 . MAX-OF-DISAPPEARED)) (when (and (not (eq (length (car diff)) (length new-list))) (setq diff-2 (elmo-list-diff (car diff) new-list))) - (elmo-msgdb-append-to-killed-list folder (car diff-2))) + (elmo-folder-kill-messages-before folder + (nth (- (length (car diff-2)) 1) + (car diff-2)))) (setq delete-list (cadr diff)) (if (or (equal diff '(nil nil)) (equal diff '(nil)) @@ -1366,23 +1533,20 @@ If update process is interrupted, return nil." (progn (elmo-folder-update-number folder) (elmo-folder-process-crosspost folder) - (list nil nil nil) ; no updates. + 0 ; no updates. ) - (if delete-list (elmo-msgdb-delete-msgs - (elmo-folder-msgdb folder) delete-list)) + (when delete-list + (elmo-folder-detach-messages folder delete-list)) (when new-list - (setq new-msgdb (elmo-folder-msgdb-create - folder - new-list - new-mark unread-cached-mark - read-uncached-mark important-mark - seen-list)) (elmo-msgdb-change-mark (elmo-folder-msgdb folder) - new-mark unread-uncached-mark) - ;; Clear seen-list. + elmo-msgdb-new-mark + elmo-msgdb-unread-uncached-mark) + (setq new-msgdb (elmo-folder-msgdb-create + folder new-list flag-table)) + ;; Clear flag-table (if (elmo-folder-persistent-p folder) - (setq seen-list (elmo-msgdb-seen-save - (elmo-folder-msgdb-path folder) nil))) + (elmo-flag-table-save (elmo-folder-msgdb-path folder) + nil)) (setq before-append nil) (setq crossed (elmo-folder-append-msgdb folder new-msgdb)) ;; process crosspost. @@ -1391,33 +1555,38 @@ If update process is interrupted, return nil." (elmo-folder-set-message-modified-internal folder t) (elmo-folder-set-mark-modified-internal folder t)) ;; return value. - (list new-msgdb delete-list crossed))) + (or crossed 0))) (quit ;; Resume to the original status. - (if before-append - (elmo-folder-set-msgdb-internal folder old-msgdb)) + (if before-append (elmo-folder-set-msgdb-internal folder old-msgdb)) (elmo-folder-set-killed-list-internal folder killed-list) nil)))) -(defun elmo-folder-messages (folder) - "Return number of messages in the FOLDER." - (length - (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder)))) +(luna-define-generic elmo-folder-detach-messages (folder numbers) + "Remove messages with NUMBERS from MSGDB.") + +(luna-define-method elmo-folder-detach-messages ((folder elmo-folder) + numbers) + (elmo-msgdb-delete-msgs (elmo-folder-msgdb folder) numbers)) + +(luna-define-generic elmo-folder-length (folder) + "Return number of messages in the FOLDER.") + +(luna-define-method elmo-folder-length ((folder elmo-folder)) + (elmo-msgdb-length (elmo-folder-msgdb folder))) -;;; (defun elmo-msgdb-load (folder &optional silent) (unless silent (message "Loading msgdb for %s..." (elmo-folder-name-internal folder))) (let ((msgdb (elmo-load-msgdb (elmo-folder-msgdb-path folder)))) (elmo-folder-set-info-max-by-numdb folder (elmo-msgdb-get-number-alist msgdb)) - + (unless silent (message "Loading msgdb for %s...done" (elmo-folder-name-internal folder))) msgdb)) - + (defun elmo-msgdb-delete-path (folder) (let ((path (elmo-folder-msgdb-path folder))) (if (file-directory-p path) @@ -1504,6 +1673,11 @@ Return a hashtable for newsgroups." (funcall func nil))) (setq types (cdr types))))) +(luna-define-method elmo-folder-rename-internal ((folder elmo-folder) + new-folder) + (error "Cannot rename %s folder" + (symbol-name (elmo-folder-type-internal folder)))) + ;;; Define folders. (elmo-define-folder ?% 'imap4) diff --git a/etc/VERSION b/etc/VERSION index 8edc2aa..d34dd22 100644 --- a/etc/VERSION +++ b/etc/VERSION @@ -127,3 +127,4 @@ 2.10.1 Watching The Wheels 2.11.x Wonderwall +2.11.3 Wanted Dead Or Alive diff --git a/wl/ChangeLog b/wl/ChangeLog index 0af9763..31f52d2 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -2,15 +2,212 @@ * Version number is increased to 2.11.4. +2003-07-24 Yuuichi Teranishi + + * wl-summary.el (wl-summary-cleanup-temp-marks): Use + wl-summary-delete-all-temp-marks. + (wl-summary-delete-all-temp-marks-on-buffer): Abolish. + + * wl-action.el (wl-summary-set-mark): Changed terminology + refile-destination -> action-argument. + (wl-summary-unset-mark): Ditto. + (wl-summary-remove-argument): Ditto. + (wl-summary-print-argument): Ditto. + + * wl-thread.el (wl-thread-update-line-on-buffer-sub): Ditto. + (wl-thread-remove-argument-region): Ditto. + (wl-thread-print-argument-region): Ditto. + (wl-thread-close): Ditto. + (wl-thread-open): Ditto. + + * wl-highlight.el (wl-highlight-action-argument-face): Ditto. + (wl-highlight-refile-destination-face is abolished) + (wl-highlight-action-argument-string): Ditto. + (wl-highlight-summary-current-line): Highlight action argument. + + * wl-highlight.el (wl-highlight-summary-deleted-face): Changed default + color for light backgrounds. + (wl-highlight-summary-answered-face): Ditto. + +2003-07-22 Yuuichi Teranishi + + * wl-summary.el (wl-summary-rescan): Use numbers in the msgdb. + + * wl-score.el (wl-summary-score-update-all-lines): Use + wl-summary-set-mark. + (wl-summary-score-update-all-lines): Kill expunged messages. + + * wl-expire.el (wl-expire-hide): Use elmo-folder-kill-messages. + +2003-07-21 Yuuichi Teranishi + + * wl-score.el (wl-summary-score-update-all-lines): Don't use msgdb + directly. + (wl-score-overview-entity-get-lines): Ditto. + (wl-score-overview-entity-get-xref): Ditto. + (wl-score-get-latest-msgs): Ditto. + (wl-summary-rescore): Ditto. + + * wl-summary.el (wl-summary-mode-map): Bind wl-summary-mark-as-answered + to "&". + (wl-summary-mark-as-answered-internal): New inline function. + (wl-summary-mark-as-answered): New function. + (wl-summary-mark-as-unanswered): Ditto. + (wl-summary-sync-marks): Modified for answered-mark synching. + +2003-07-20 Hiroya Murata + + * wl-action.el (wl-summary-set-mark): Fixed last change. + +2003-07-20 Yuuichi Teranishi + + * wl-summary.el (wl-summary-mark-as-read-internal): Fixed the + behavior of wl-summary-unread-message-hook + (Pointed out by akira yamada ). + +2003-07-19 Hiroya Murata + + * wl-e21.el (wl-summary-toolbar): Follow the rename of + wl-summary-delete. + * wl-xmas.el (wl-summary-toolbar): Ditto. + + * wl-action.el (wl-summary-set-mark): Don't override current + temp-mark. + + * wl-refile.el (wl-refile-get-field-value): Fixed and simplified. + +2003-07-19 Yuuichi Teranishi + + * wl-refile.el (wl-refile-learn): Don't use msgdb. + (wl-refile-msgid-learn): Ditto. + (wl-refile-get-field-value): Ditto. + + * wl-mime.el (wl-mime-combine-message/partial-pieces): Don't use msgdb. + + * wl-expire.el (wl-expire-message-p): Renamed from wl-expire-msg-p. + (wl-expire-delete-reserved-messages): Renamed from + wl-expire-reserve-marked-msgs-from-list. + (wl-expire-delete): Removed argument `msgdb'. + (wl-expire-refile): Ditto. + (wl-expire-refile-with-copy-reserve-msg): Ditto. + (wl-expire-archive-number-delete-old): Ditto; Use folder instead of + mark-alist as argument. + (wl-expire-archive-number1): Removed argument `msgdb'. + (wl-expire-archive-number2): Ditto. + (wl-expire-archive-date): Ditto. + (wl-expire-localdir-date): Ditto. + (wl-expire-hide): Ditto. + (wl-archive-number1): Ditto. + (wl-archive-number2): Ditto. + (wl-archive-date): Ditto. + (wl-archive-folder): Ditto. + All other related portions are changed. + 2003-07-19 Yoichi NAKAYAMA * wl-draft.el (wl-draft-send-confirm): Change message. Now up/down mean move up and down. (suggested by Takashi Kawachi) +2003-07-18 Yuuichi Teranishi + + * wl-acap.el (toplevel): Don't require un-define. + +2003-07-18 Yuuichi Teranishi + + * wl-thread.el (wl-thread-delete-message): Always update + wl-summary-buffer-number-list. + + * wl-action.el (wl-summary-print-destination): + Do nothing when folder is nil. + +2003-07-18 Hiroya Murata + + * wl-summary.el (wl-summary-prefetch-region-no-mark): Update + persistent mark when prefetch is succeeded. + 2003-07-17 Yuuichi Teranishi + * wl-expire.el (wl-expire-delete): Use elmo-folder-detach-messages + instead of elmo-msgdb-delete-msgs. + (wl-expire-refile-with-copy-reserve-msg): Ditto. + (wl-expire-hide): Ditto. + + * wl-summary.el (wl-summary-delete-all-msgs): Ditto. + + * wl-thread.el (wl-thread-update-line-on-buffer-sub): Don't use + elmo-msgdb interface. + (wl-thread-get-exist-children): Likewise. + (wl-thread-insert-message): Likewise. + (wl-thread-msg-mark-as-important): Likewise. + (wl-thread-insert-entity-sub): Likewise. + (wl-thread-get-children-msgs-uncached): Likewise. + + * wl-summary.el (wl-summary-sync-all-init): Use elmo-folder-length. + (wl-summary-prefetch-msg): Don't use elmo-msgdb interface. + (wl-summary-sync-update): Likewise. + (wl-summary-auto-select-msg-p): Likewise. + (wl-summary-update-thread): Likewise. + (wl-summary-mark-as-important): Likewise. + (wl-summary-jump-to-msg-internal): Likewise. + (wl-summary-redisplay-internal): Likewise. + (wl-summary-print-message-with-ps-print): Likewise. + (wl-summary-folder-info-update): Likewise. + + * wl-folder.el (wl-folder-check-one-entity): + elmo-folder-count-flags instead of wl-summary-count-unread. + * wl-draft.el (wl-draft-normal-send-func): Fixed last change. + * wl-action.el (wl-summary-define-mark-action): Fixed region function. + + * wl-summary.el (wl-summary-set-message-modified): + Call wl-summary-set-mark-modified. + (wl-summary-delete-messages-on-buffer): Call + wl-folder-set-folder-updated instead of wl-folder-update-unread. + (wl-summary-sync-update): Call elmo-folder-length instead of + elmo-folder-messages. + (wl-summary-insert-headers): Don't call + elmo-folder-list-message-entities. + +2003-07-17 Hiroya Murata + + * wl-action.el (wl-summary-define-mark-action): Call + `wl-summary-set-mark' with argument `data'. + (wl-summary-auto-refile): Fixed order of arguments when call + `wl-summary-refile'. + +2003-07-16 Yuuichi Teranishi + + * wl-vars.el (wl-summary-mark-action-list): Define resend action. + + * wl-summary.el (wl-summary-mode-map): Bind resend action. + + * wl-highlight.el (wl-highlight-summary-disposed-face): New face + (Renamed from wl-highlight-summary-deleted-face). + (wl-highlight-summary-resend-face): New face. + + (wl-highlight-summary-deleted-face): Renamed from + wl-highlight-summary-erased-face. + + * wl-address.el (wl-complete-field-to): Added optional argument prompt. + + * wl-action.el (wl-summary-get-resend-address): New function. + (wl-summary-exec-action-resend): Ditto. + (wl-summary-exec-action-resend-subr): Ditto. + + * w-thread.el (wl-thread-copy): Removed definition. + (wl-thread-refile): Ditto. + (wl-thread-delete): Ditto. + (wl-thread-target-mark): Ditto. + + * wl-action.el (wl-summary-register-target-mark): Fixed argument. + (wl-summary-target-mark-set-action): Fixed. + (wl-summary-define-mark-action): Fixed quotation. + (wl-summary-move-mark-list-messages): Display message. + (wl-summary-define-mark-action): Define thread functions. + (wl-summary-exec-action-refile): Changed message. + (wl-summary-exec): Ditto. + 2003-07-15 Mito * wl-summary.el (wl-summary-entity-info-msg): Don't replace '%' to @@ -18,9 +215,140 @@ 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. + (wl-summary-target-mark-prefetch): Use it. + (wl-summary-target-mark-delete): Ditto. + (toplevel): Rearranged definition order. + (wl-summary-mode-map): Bind wl-summary-erase-region to "rD". + (wl-summary-target-mark-erase): Rewrite. + (wl-summary-erase-region): New function. + (wl-summary-exec-action-erase): Changed message. + (wl-summary-move-mark-list-messages): New function. + (wl-summary-exec-action-delete): Use it. + (wl-summary-exec-action-erase): Ditto. + + * wl-vars.el (wl-summary-reserve-mark-list): Added "d" and "i". + (wl-summary-skip-mark-list): Added "d". + + * wl-summary.el (wl-summary-cursor-move-surface): Bind case-fold-search + while searching. + + * wl-vars.el (wl-summary-mark-action-list): Moved from wl-summary.el + and define using defcustom; + Define 4th element as a face. + + * wl-summary.el (wl-summary-incorporate): Use + `wl-summary-prefetch-region-no-mark' instead of + `wl-summary-prefetch-region'. + (wl-summary-prefetch-region-no-mark): Revival of old + `wl-summary-prefetch-region'. + (wl-summary-mark-action-list): Moved to wl-vars.el + + * wl-highlight.el (wl-highlight-summary-current-line): Decide + face according to the `wl-summary-mark-action-list'. + (wl-highlight-summary-current-line): Ditto; + Removed destination highlighting. + + * wl-highlight.el (wl-highlight-summary-prefetch-face): New face. + (wl-highlight-summary-line-string): Highlight for "i" mark. + (wl-highlight-summary-current-line): Ditto. + + * wl-thread.el (wl-thread-print-destination-region): Avoid error when + no destination. + + * wl-summary.el (wl-summary-prefetch-msg): If cache file already + exists, just go ahead. + (wl-summary-prefetch-region): Rewrite. + (wl-summary-prefetch): Ditto. + (wl-summary-mark-action-list): Define mark "i" and prefetch action. + (wl-summary-exec-action-prefetch): New function. + (wl-summary-target-mark-prefetch): Rewrite. + +2003-07-13 Yuuichi Teranishi + + * wl-highlight.el (wl-highlight-summary-erased-face): New face. + (wl-highlight-summary-line-string): Added "d" and "D". + (wl-highlight-summary-current-line): Ditto. + + * wl-thread.el (wl-thread-update-line-on-buffer-sub): Follow the change + in wl-summary.el. + (wl-thread-insert-entity-sub): Ditto. + (wl-thread-remove-destination-region): Ditto. + (wl-thread-print-destination-region): Ditto. + + * wl-summary.el (wl-summary-buffer-refile-list, + wl-summary-buffer-delete-list, + wl-summary-buffer-copy-list): Abolish. + (wl-summary-buffer-temp-mark-list): New buffer local variable. + All other related portions are changed. + (wl-summary-mark-action-list): New variable. + (wl-summary-set-mark): New function. + (wl-summary-register-target-mark): Ditto. + (wl-summary-unregister-target-mark): Ditto. + (wl-summary-have-target-mark-p): Ditto. + (wl-summary-register-temp-mark): Ditto. + (wl-summary-unregister-temp-mark): Ditto. + (wl-summary-registered-temp-mark): Ditto. + (wl-summary-collect-temp-mark): Ditto. + (wl-summary-unset-mark): Ditto. + (wl-summary-set-target-mark): Ditto. + (wl-summary-unset-target-mark): Ditto. + (wl-summary-set-action-generic): Ditto. + (wl-summary-unset-action-generic): Ditto. + (wl-summary-exec-action-delete): Ditto. + (wl-summary-exec-action-erase): Ditto. + (wl-summary-set-action-refile): Ditto. + (wl-summary-set-action-refile-subr): Ditto. + (wl-summary-unset-action-refile): Ditto. + (wl-summary-make-destination-numbers-list): Ditto. + (wl-summary-exec-action-refile): Ditto. + (wl-summary-set-action-copy): Ditto. + (wl-summary-unset-action-copy): Ditto. + (wl-summary-exec-action-copy): Ditto. + (wl-summary-collect-numbers-region): Ditto. + (wl-summary-delete): Rewrite. + (wl-summary-erase): Ditto. + (wl-summary-remove-destination): Ditto. + (wl-summary-exec): Ditto. + (wl-summary-exec-region): Ditto. + (wl-summary-target-mark-erase): Ditto. + (wl-summary-refile): Ditto. + (wl-summary-copy): Ditto. + (wl-summary-unmark): Ditto. + (wl-summary-delete-all-mark): Ditto. + (wl-summary-mark-line): Don't highlight. + (wl-summary-target-mark-delete): Use wl-summary-register-temp-mark. + (wl-summary-target-mark-refile-subr): Rewrite. + + (wl-summary-copy-prev-destination): Abolish. + 2003-07-12 Yoichi NAKAYAMA * wl-vars.el (wl-thread-indent-level, wl-thread-*-str): Choose @@ -99,6 +427,77 @@ * wl-util.el (wl-as-coding-system): Define for non-mule too. +2003-04-05 Hiroya Murata + + * wl-summary.el (wl-summary-mark-as-important): Fixed the last + change. + +2003-04-02 Yuuichi Teranishi + + * wl-summary.el (wl-summary-rescan): Follow the changes in wl-score + API. + (wl-summary-sync-update): Ditto. + + * wl-score.el (wl-score-get-score-alist): Changed argument. + (wl-summary-rescore-msgs): Likewise. + (wl-summary-score-headers): Likewise. + (wl-score-headers): Likewise; + Use elmo-folder-do-each-message-entity, etc. + (wl-summary-score-effect): Follow the changes above. + (wl-summary-rescore): Ditto. + (wl-score-get-latest-msgs): Follow the changes in elmo-msgdb API. + (wl-score-get-overview): Abolish. + + * wl-summary.el (wl-summary-default-from): Follow the API change in + elmo-msgdb. + (wl-summary-count-unread): Ditto. + (wl-summary-detect-mark-position): Ditto. + (wl-summary-overview-entity-compare-by-date): Ditto. + (wl-summary-overview-entity-compare-by-number): Ditto. + (wl-summary-overview-entity-compare-by-from): Ditto. + (wl-summary-overview-entity-compare-by-subject): Ditto. + (wl-summary-get-list-info): Ditto. + (wl-summary-rescan): Ditto. + (wl-summary-jump-to-msg-by-message-id): Ditto. + (wl-summary-sync-update): Ditto; Removed comment. + (wl-summary-insert-thread-entity): Renamed to wl-summary-insert-thread. + (wl-summary-insert-message): Use wl-summary-insert + (wl-summary-insert-sequential): Changed argument msgdb to folder. + (wl-summary-insert-headers): Changed argument overview to folder. + (wl-summary-search-by-subject): Likewise. + (wl-summary-insert-thread): Renamed from + wl-summary-insert-thread-entity and changed argument msgdb to folder. + + * wl-folder.el (wl-folder-check-one-entity): Treat elmo-imap4-bye-error + too. + + * wl-fldmgr.el (wl-add-entity-sub): Use elmo-string-member instead of + wl-string-member. + +2003-03-25 Yuuichi Teranishi + + * wl-draft.el (wl-draft-do-fcc): Follow the changes in + elmo-folder-append-buffer. + (wl-draft-queue-append): Likewise. + + * wl-mime.el (wl-message-delete-current-part): Ditto. + (wl-summary-burst-subr): Ditto. + + * wl-news.el.in (wl-news-send-news): Ditto. + +2003-03-24 Yuuichi Teranishi + + * wl-summary.el (wl-summary-mark-as-read-internal): New inline + function. + (wl-summary-mark-as-read, wl-summary-mark-as-unread): Use it. + (wl-summary-update-mark): Enclose with save-excursion. + (wl-summary-mark-as-read-internal): Fixed last change. + (wl-summary-mark-as-important): Use 3rd argument of + elmo-folder-unmark-important, elmo-folder-mark-as-important; + Don't use elmo-msgdb-set-mark. + (wl-summary-redisplay-internal): If msgdb flag is already read, + just update the mark on buffer. + 2003-03-30 Yoichi NAKAYAMA * wl-fldmgr.el (wl-fldmgr-delete): Move confirmation to elmo side, @@ -680,6 +1079,25 @@ (wl-user-agent-compose): Bind wl-draft-buffer-style with switch-function. +2002-11-07 Yuuichi Teranishi + + * wl-draft.el (wl-user-agent-compose): Delete special case for + switch-to-buffer-other-window. + + * wl-summary.el (wl-summary-reply): Don't treat switch buffer here. + (wl-summary-forward): Ditto. + + * wl-vars.el (wl-draft-buffer-style): Added choice of keep and + function. + (wl-draft-buffer-style): New use option. + + * wl-draft.el (wl-draft-create-buffer): Abolish argument `full'. + (wl-draft): Follow the change above. + (wl-draft-create-buffer): Use wl-draft-reply-buffer-style and + wl-draft-buffer-style. + (wl-user-agent-compose): Bind wl-draft-buffer-style with + switch-function. + 2002-11-01 Tomotaka SUWA * wl-address.el (wl-address-make-completion-entry): Extracted from @@ -694,10 +1112,47 @@ * wl-message.el (wl-message-get-original-buffer): Avoid 'Selecting deleted buffer' error when original buffer is killed. +2002-10-28 Yuuichi Teranishi + + * wl-summary.el (wl-summary-next-message): Use + elmo-message-accessible-p instead of elmo-message-cached-p. + +2002-10-27 Yuuichi Teranishi + + * wl-util.el (wl-regexp-opt): Define as an alias for elmo-regexp-opt. + + * wl-thread.el (wl-thread-open-all-unread): Use + elmo-folder-list-flagged instead of + elmo-folder-list-messages-mark-match. + + * wl-summary.el (wl-summary-sync-marks): Use elmo-folder-list-flagged + instead of elmo-folder-list-messages-mark-match. + (wl-summary-move-spec-alist): New variable. + (wl-summary-move-spec-plugged-alist, + wl-summary-move-spec-unplugged-alist): Abolish. + (wl-summary-next-message): Follow the change above. + (wl-summary-save-view-cache): Call wl-summary-delete-all-temp-marks + with 'no-msg' argument. + + * wl-message.el (wl-message-buffer-prefetch-move-spec-alist): New + variable. + (wl-message-buffer-prefetch-move-spec-plugged-alist, + wl-message-buffer-prefetch-move-spec-unplugged-alist): Abolish. + (wl-message-buffer-prefetch-get-next): Follow the change above. + 2002-10-26 Yuuichi Teranishi + * wl-version.el (wl-version): Changed codename. + * Version number is increased to 2.11.0. +2002-10-24 Hiroya Murata + + * wl-draft.el (wl-draft-reply-saved-variables): New constant. + (wl-draft-reply): Append `wl-draft-reply-saved-variables' to + `wl-draft-config-variables'. + (wl-draft-kill): Fixed problem when the draft is reedit. + 2002-10-24 Yuuichi Teranishi * wl-draft.el (wl-draft-highlight-and-recenter): Restore @@ -735,6 +1190,27 @@ * wl-mime.el (wl-message-delete-current-part): Use `delete-region' instead of `kill-region'. +2002-10-18 Yuuichi Teranishi + + * wl-highlight.el (wl-highlight-summary-answered-face): New face. + (wl-highlight-summary-line-string): Use it. + (wl-highlight-summary-current-line): Ditto. + + * wl-mime.el (wl-message-delete-current-part): Check the class of + mime-entity. + + * wl-draft.el (wl-draft-reedit): Set wl-draft-parent-folder. + + * wl-summary.el (wl-summary-make-number-list): Initialize. + (wl-summary-update-mark): New function. + (wl-summary-reply): Put `answered' mark on the message. + (wl-summary-reply): Set `number' argument to wl-draft-reply. + + * wl-draft.el (wl-draft-parent-number): New buffer local variable. + (wl-draft-reply): Added optional argument `number'; + Set wl-draft-parent-number. + (wl-draft-kill): Delete answered mark if it is a reply. + 2002-10-18 Yoichi NAKAYAMA * wl-mime.el (wl-mime-preview-follow-current-region): New function @@ -747,11 +1223,6 @@ * wl-mule.el (wl-message-define-keymap): Ditto. * wl-xmas.el (wl-message-define-keymap): Ditto. -2002-10-18 Yuuichi Teranishi - - * wl-mime.el (wl-message-delete-current-part): Check the class of - mime-entity. - 2002-10-16 Yoichi NAKAYAMA * wl-mime.el (wl-message-delete-current-part): New function. @@ -797,6 +1268,39 @@ * wl-mime.el (wl-summary-burst): Get elmo folder correctly. Take prefix argument to force asking the destination folder. +2002-09-26 Hiroya Murata + + * wl-summary.el (wl-summary-prefetch-msg): If mark is changed, + count and update status. + +2002-09-24 Yuuichi Teranishi + + * wl-summary.el (wl-summary-redisplay-internal): If + `elmo-message-use-cache-p' is non-nil, call `elmo-message-set-cached' + after fetching. + +2002-09-24 Hiroya Murata + + * wl-summary.el (wl-summary-mark-as-read-all): Bind new-mark. + (wl-summary-mark-as-read): Don't call elmo-message-set-cached. + + * wl-vars.el (toplevel): Require 'elmo-msgdb. + +2002-09-20 Yuuichi Teranishi + + * wl-summary.el (wl-summary-buffer-mark-modified): Abolish + (All other related portions are changed). + (wl-summary-mark-as-read-all): Rewrite. + +2002-09-19 Yuuichi Teranishi + + * wl-summary.el (wl-summary-sync-marks): Set no-modeline argument of + `wl-summary-mark-as-read'. + (wl-summary-mark-as-unread): Rewrite. + (wl-summary-mark-as-read): Added no-modeline argument. + (wl-summary-resume-cache-status): Rewrite. + (wl-summary-exec-subr): Remove unused local variable. + 2002-09-23 Yoichi NAKAYAMA * wl-summary.el (wl-summary-cursor-move-surface): Add missing @@ -814,6 +1318,72 @@ function, a wrapper for `mime-decrypt-application/pgp-encrypted'. (wl-mime-setup): Add its entry. +2002-09-17 Yuuichi Teranishi + + * wl-summary.el (wl-summary-prefetch-msg): Use elmo-message-set-cached. + (wl-summary-delete-cache): Likewise. + (wl-summary-mark-as-read): Rewrite. + +2002-09-16 Yuuichi Teranishi + + * wl-folder.el (wl-folder-check-one-entity): Follow the API change on + `wl-summary-count-unread'. + + * wl-summary.el (wl-summary-sync-marks): Treat global-mark here. + + * wl-version.el (wl-version): Set codename for `elmo-mark' branch. + +2002-09-13 Yuuichi Teranishi + + * wl-vars.el (wl-summary-unread-mark, wl-summary-important-mark, + wl-summary-new-mark, wl-summary-unread-uncached-mark, + wl-summary-unread-cached-mark, wl-summary-read-uncached-mark): + Renamed to the elmo-msgdb-*-mark. + (wl-summary-score-marks): Follow the change above. + (wl-summary-auto-refile-skip-marks): Ditto. + (wl-summary-incorporate-marks): Ditto. + (wl-summary-expire-reserve-marks): Ditto. + + * wl-thread.el (wl-thread-open-all-unread): Follow the variable name + changes. + (wl-thread-insert-top): Changed updating message. + + * wl-summary.el (wl-summary-buffer-answered-count): New buffer local + variable. + (wl-summary-count-unread): Count answered marks. + (wl-summary-rescan): Call wl-summary-insert-message instead of + wl-summary-append-message-func-internal. + (wl-summary-rescan): Don't call wl-summary-make-number-list. + (wl-summary-prefetch-msg): Follow the variable name changes. + (wl-summary-prefetch-region): Ditto. + (wl-summary-mark-as-read-all): Follow the API changes; + Don't call elmo-folder-replace-marks. + (wl-summary-delete-cache): Follow the variable name changes. + (wl-summary-resume-cache-status): Ditto. + (wl-summary-update-status-marks): New function. + (wl-summary-insert-message): New function. + (wl-summary-sync-marks): Follow the variable name changes. + (wl-summary-sync-update): Synchronize to the msgdb, too; + Changed update messages. + (wl-summary-make-number-list): Rewrite. + (wl-summary-insert-sequential): Update wl-summary-buffer-number-list. + (wl-summary-mark-as-unread): Follow the API changes. + (wl-summary-exec-subr): Follow the variable name changes. + (wl-summary-mark-as-read): Ditto. + (wl-summary-move-spec-plugged-alist): Ditto. + (wl-summary-move-spec-unplugged-alist): Ditto. + (wl-summary-cursor-move-surface): Ditto. + + * wl-highlight.el (wl-highlight-summary-line-string): Follow the + variable name changes. + (wl-highlight-summary-current-line): Ditto. + + * wl-expire.el (wl-expire-refile): Follow the API change in + elmo-folder-move-messages. + (wl-expire-refile-with-copy-reserve-msg): Ditto. + (wl-summary-archive): Use elmo-folder-msgdb instead of + elmo-msgdb-load. + 2002-09-13 Yoichi NAKAYAMA * wl-mime.el (wl-draft-preview-message): Restore the position diff --git a/wl/wl-acap.el b/wl/wl-acap.el index 8ecd7c2..f9be6c2 100644 --- a/wl/wl-acap.el +++ b/wl/wl-acap.el @@ -28,14 +28,14 @@ ;;; Code: ;; -(cond - ((and (not (featurep 'utf-2000)) - (module-installed-p 'un-define)) - (require 'un-define)) - ((and (featurep 'xemacs) - (not (featurep 'utf-2000)) - (module-installed-p 'xemacs-ucs)) - (require 'xemacs-ucs))) +;;(cond +;; ((and (not (featurep 'utf-2000)) +;; (module-installed-p 'un-define)) +;; (require 'un-define)) +;; ((and (featurep 'xemacs) +;; (not (featurep 'utf-2000)) +;; (module-installed-p 'xemacs-ucs)) +;; (require 'xemacs-ucs))) (require 'custom) (require 'cus-edit) (require 'wl-vars) diff --git a/wl/wl-action.el b/wl/wl-action.el new file mode 100644 index 0000000..e954bf3 --- /dev/null +++ b/wl/wl-action.el @@ -0,0 +1,943 @@ +;;; wl-action.el --- Mark and actions in the Summary mode for Wanderlust. + +;; Copyright (C) 2003 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; Keywords: mail, net news + +;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;; + +;;; Commentary: +;; + +;;; Code: +;; + +(require 'wl-summary) + +(defsubst wl-summary-action-mark (action) + (nth 0 action)) +(defsubst wl-summary-action-symbol (action) + (nth 1 action)) +(defsubst wl-summary-action-argument-function (action) + (nth 2 action)) +(defsubst wl-summary-action-set-function (action) + (nth 3 action)) +(defsubst wl-summary-action-exec-function (action) + (nth 4 action)) +(defsubst wl-summary-action-face (action) + (nth 5 action)) +(defsubst wl-summary-action-docstring (action) + (nth 6 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. +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 cur-mark) + (prog1 + (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) + cur-mark (nth 1 (wl-summary-registered-temp-mark number))) + (if (wl-summary-reserve-temp-mark-p cur-mark) + (when interactive + (error "Already marked as `%s'" cur-mark)) + (when (and interactive + (null data) + (wl-summary-action-argument-function action)) + (setq data (funcall (wl-summary-action-argument-function action) + (wl-summary-action-symbol action) + number))) + (wl-summary-unset-mark number) + (when visible + (wl-summary-mark-line set-mark) + (when wl-summary-highlight + (wl-highlight-summary-current-line)) + (when data + (wl-summary-print-argument number data))) + ;; Set action. + (funcall (wl-summary-action-set-function action) + number + (wl-summary-action-mark action) + data) + (set-buffer-modified-p nil) + ;; Return value. + 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-register-target-mark (number mark data) + (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)) + +(defun wl-summary-target-mark-set-action (action) + (unless (eq (wl-summary-action-symbol action) 'target-mark) + (save-excursion + (goto-char (point-min)) + (let ((numlist wl-summary-buffer-number-list) + number mlist data) + ;; use firstly marked message. + (when (wl-summary-action-argument-function action) + (while numlist + (if (memq (car numlist) wl-summary-buffer-target-mark-list) + (setq number (car numlist) + numlist nil)) + (setq numlist (cdr numlist))) + (wl-summary-jump-to-msg number) + (setq data (funcall (wl-summary-action-argument-function action) + (wl-summary-action-symbol action) number))) + (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 (wl-summary-action-mark action) + number nil data) + (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) + (wl-summary-action-mark action) data) + (setq wl-summary-buffer-target-mark-list + (delq (car mlist) wl-summary-buffer-target-mark-list)) + (setq mlist (cdr mlist))))))) + +;; 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)) + (when wl-summary-highlight + (wl-highlight-summary-current-line)) + (when (wl-summary-action-argument-function action) + (wl-summary-remove-argument))) + (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. + (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)) + (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) + (message (concat message "done")) + (wl-summary-set-message-modified) + ;; Return the operation failed message numbers. + (if result + 0 + (length refiles)))))) + +(defun wl-summary-get-refile-destination-subr (action number learn) + (let* ((number (or number (wl-summary-message-number))) + (msgid (and number + (elmo-message-field wl-summary-buffer-elmo-folder + number 'message-id))) + (entity (and number + (elmo-message-entity wl-summary-buffer-elmo-folder + number))) + folder cur-mark tmp-folder) + (catch 'done + (when (null entity) + (message "Cannot decide destination.") + (throw 'done nil)) + (when (null number) + (message "No message.") + (throw 'done nil)) + (setq folder (wl-summary-read-folder + (or (wl-refile-guess entity) wl-trash-folder) + (format "for %s " action))) + ;; 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 learn + (wl-refile-learn entity folder)) + folder))) + +;;; Actions +(defun wl-summary-define-mark-action () + (interactive) + (dolist (action wl-summary-mark-action-list) + (fset (intern (format "wl-summary-%s" (wl-summary-action-symbol action))) + `(lambda (&optional number data) + ,(wl-summary-action-docstring action) + (interactive) + (wl-summary-set-mark ,(wl-summary-action-mark action) + number (interactive-p) data))) + (fset (intern (format "wl-summary-%s-region" + (wl-summary-action-symbol action))) + `(lambda (beg end) + ,(wl-summary-action-docstring action) + (interactive "r") + (goto-char beg) + (wl-summary-mark-region-subr + (quote ,(intern (format "wl-summary-%s" + (wl-summary-action-symbol action)))) + beg end + (if (quote ,(wl-summary-action-argument-function action)) + (funcall (function + ,(wl-summary-action-argument-function action)) + (quote ,(wl-summary-action-symbol action)) + (wl-summary-message-number)))))) + (fset (intern (format "wl-summary-target-mark-%s" + (wl-summary-action-symbol action))) + `(lambda () + ,(wl-summary-action-docstring action) + (interactive) + (wl-summary-target-mark-set-action (quote ,action)))) + (fset (intern (format "wl-thread-%s" + (wl-summary-action-symbol action))) + `(lambda (arg) + ,(wl-summary-action-docstring action) + (interactive "P") + (wl-thread-call-region-func + (quote ,(intern (format "wl-summary-%s-region" + (wl-summary-action-symbol action)))) + arg) + (if arg + (wl-summary-goto-top-of-current-thread)) + (if (not wl-summary-move-direction-downward) + (wl-summary-prev) + (wl-thread-goto-bottom-of-sub-thread) + (if wl-summary-buffer-disp-msg + (wl-summary-redisplay))))))) + +(defun wl-summary-get-dispose-folder (folder) + (if (string= folder wl-trash-folder) + 'null + (let* ((type (or (wl-get-assoc-list-value wl-dispose-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))))) + +;; Dispose action. +(defun wl-summary-exec-action-dispose (mark-list) + (wl-summary-move-mark-list-messages mark-list + (wl-summary-get-dispose-folder + (wl-summary-buffer-folder-name)) + "Disposing messages...")) + +;; Delete action. +(defun wl-summary-exec-action-delete (mark-list) + (wl-summary-move-mark-list-messages mark-list + 'null + "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)))) + +(defun wl-summary-get-refile-destination (action number) + "Decide refile destination." + (wl-summary-get-refile-destination-subr action number t)) + +(defun wl-summary-exec-action-refile (mark-list) + (save-excursion + (let ((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 "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))) + (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-get-copy-destination (action number) + (wl-summary-get-refile-destination-subr action number nil)) + +(defun wl-summary-exec-action-copy (mark-list) + (save-excursion + (let ((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-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))) + +;; Resend. +(defun wl-summary-get-resend-address (action number) + "Decide resend address." + (wl-complete-field-to "Resend message to: ")) + +(defun wl-summary-exec-action-resend (mark-list) + (let ((failure 0)) + (dolist (mark-info mark-list) + (if (condition-case nil + (progn + (wl-summary-exec-action-resend-subr (car mark-info) + (nth 2 mark-info)) + t) + (error)) + (wl-summary-unmark (car mark-info)) + (incf failure))) + failure)) + +(defun wl-summary-exec-action-resend-subr (number address) + "Resend the message with NUMBER to ADDRESS." + (message "Resending message to %s..." address) + (let ((folder wl-summary-buffer-elmo-folder)) + (save-excursion + ;; We first set up a normal mail buffer. + (set-buffer (get-buffer-create " *wl-draft-resend*")) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (setq wl-sent-message-via nil) + ;; Insert our usual headers. + (wl-draft-insert-from-field) + (wl-draft-insert-date-field) + (insert "To: " address "\n") + (goto-char (point-min)) + ;; Rename them all to "Resent-*". + (while (re-search-forward "^[A-Za-z]" nil t) + (forward-char -1) + (insert "Resent-")) + (widen) + (forward-line) + (delete-region (point) (point-max)) + (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))) + (goto-char (point-min)) + (search-forward "\n\n") + (forward-char -1) + (save-restriction + (narrow-to-region beg (point)) + (wl-draft-delete-fields wl-ignored-resent-headers) + (goto-char (point-max))) + (insert mail-header-separator) + ;; Rename all old ("Previous-")Resent headers. + (while (re-search-backward "^\\(Previous-\\)*Resent-" beg t) + (beginning-of-line) + (insert "Previous-")) + ;; Quote any "From " lines at the beginning. + (goto-char beg) + (when (looking-at "From ") + (replace-match "X-From-Line: "))) + ;; Send it. + (wl-draft-dispatch-message) + (kill-buffer (current-buffer))) + (message "Resending message to %s...done" address))) + +;;; +(defun wl-summary-remove-argument () + (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-action-argument + buf eol)) + (setq re (next-single-property-change rs 'wl-summary-action-argument + buf eol)) + (put-text-property rs re 'wl-summary-action-argument 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 + (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)))) + ;; 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 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) + (when (> failures 0) + (format "%d execution(s) were 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-argument (msg-num folder) + "Print action argument on line." + (when folder + (wl-summary-remove-argument) + (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-action-argument t) + (goto-char re) + (wl-highlight-action-argument-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) + (funcall (symbol-function '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 (funcall (symbol-function 'wl-summary-refile) number dst) + (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-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 data) + (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 data) + ;; closed + (setq children (wl-thread-get-children-msgs number)) + (while children + (funcall function (pop children) data))) + (forward-line 1)))) + (while (not (eobp)) + (funcall function (wl-summary-message-number) data) + (forward-line 1)))))) + +(defun wl-summary-target-mark-region (beg end) + (interactive "r") + (wl-summary-mark-region-subr 'wl-summary-target-mark beg end nil)) + +(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)) + +(require 'product) +(product-provide (provide 'wl-action) (require 'wl-version)) + +;;; wl-action.el ends here diff --git a/wl/wl-address.el b/wl/wl-address.el index d168f52..a7d0125 100644 --- a/wl/wl-address.el +++ b/wl/wl-address.el @@ -274,12 +274,12 @@ Matched address lists are append to CL." (setq entries (cdr entries))) (append result cl))) -(defun wl-complete-field-to () +(defun wl-complete-field-to (prompt) (interactive) (let ((cl wl-address-completion-list)) (if cl - (completing-read "To: " cl) - (read-string "To: ")))) + (completing-read (or prompt "To: ") cl) + (read-string (or prompt "To: "))))) (defalias 'wl-address-quote-specials 'elmo-address-quote-specials) diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 8da2ca0..b75cccf 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -87,6 +87,12 @@ e.g. ((string-match \".*@domain2$\" wl-draft-parent-folder) (\"From\" . \"user@domain2\"))))") +(defvar wl-draft-parent-number nil) + +(defconst wl-draft-reply-saved-variables + '(wl-draft-parent-folder + wl-draft-parent-number)) + (defvar wl-draft-config-sub-func-alist '((body . wl-draft-config-sub-body) (top . wl-draft-config-sub-top) @@ -112,6 +118,7 @@ e.g. (make-variable-buffer-local 'wl-draft-fcc-list) (make-variable-buffer-local 'wl-draft-reply-buffer) (make-variable-buffer-local 'wl-draft-parent-folder) +(make-variable-buffer-local 'wl-draft-parent-number) (defsubst wl-smtp-password-key (user mechanism server) (format "SMTP:%s/%s@%s" @@ -280,7 +287,7 @@ e.g. "Return t when From address in the current message is user's self one or not." (wl-address-user-mail-address-p (or (elmo-field-body "From") ""))) -(defun wl-draft-reply (buf with-arg summary-buf) +(defun wl-draft-reply (buf with-arg summary-buf &optional number) "Reply to BUF buffer message. Reply to author if WITH-ARG is non-nil." ;;;(save-excursion @@ -439,8 +446,12 @@ Reply to author if WITH-ARG is non-nil." (cons 'References references) (cons 'Mail-Followup-To mail-followup-to)) nil nil nil nil parent-folder) + (setq wl-draft-parent-number number) (setq wl-draft-reply-buffer buf) - (run-hooks 'wl-reply-hook))) + (setq wl-draft-config-variables + (append wl-draft-reply-saved-variables + wl-draft-config-variables))) + (run-hooks 'wl-reply-hook)) (defun wl-draft-reply-position (position) (cond ((eq position 'body) @@ -655,31 +666,20 @@ Reply to author if WITH-ARG is non-nil." (defun wl-default-draft-cite () (let ((mail-yank-ignored-headers "[^:]+:") (mail-yank-prefix "> ") - (summary-buf wl-current-summary-buffer) - (message-buf (get-buffer (wl-current-message-buffer))) - from date cite-title num entity) - (if (and summary-buf - (buffer-live-p summary-buf) - message-buf - (buffer-live-p message-buf)) - (progn - (with-current-buffer summary-buf - (let ((elmo-mime-charset wl-summary-buffer-mime-charset)) - (setq num (save-excursion - (set-buffer message-buf) - wl-message-buffer-cur-number)) - (setq entity (elmo-msgdb-overview-get-entity - num (wl-summary-buffer-msgdb))) - (setq date (elmo-msgdb-overview-entity-get-date entity)) - (setq from (elmo-msgdb-overview-entity-get-from entity)))) - (setq cite-title (format "At %s,\n%s wrote:" - (or date "some time ago") - (if wl-default-draft-cite-decorate-author - (funcall wl-summary-from-function - (or from "you")) - (or from "you")))))) - (and cite-title - (insert cite-title "\n")) + date from cite-title) + (save-restriction + (if (< (mark t) (point)) + (exchange-point-and-mark)) + (narrow-to-region (point)(point-max)) + (setq date (std11-field-body "date") + from (std11-field-body "from"))) + (when (or date from) + (insert (format "At %s,\n%s wrote:\n" + (or date "some time ago") + (if wl-default-draft-cite-decorate-author + (funcall wl-summary-from-function + (or from "you")) + (or from "you"))))) (mail-indent-citation))) (defvar wl-draft-buffer nil "Draft buffer to yank content.") @@ -696,6 +696,7 @@ Reply to author if WITH-ARG is non-nil." (if arg (let (buf mail-reply-buffer) (elmo-set-work-buf + (insert "\n") (yank) (setq buf (current-buffer))) (setq mail-reply-buffer buf) @@ -759,6 +760,23 @@ Reply to author if WITH-ARG is non-nil." (or force-kill (y-or-n-p "Kill Current Draft? "))) (let ((cur-buf (current-buffer))) + (when (and wl-draft-parent-number + (not (string= wl-draft-parent-folder ""))) + (let* ((number wl-draft-parent-number) + (folder-name wl-draft-parent-folder) + (folder (wl-folder-get-elmo-folder folder-name)) + buffer) + (if (and (setq buffer (wl-summary-get-buffer folder-name)) + (with-current-buffer buffer + (string= (wl-summary-buffer-folder-name) + folder-name))) + (with-current-buffer buffer + (elmo-folder-unmark-answered folder (list number)) + (wl-summary-jump-to-msg number) + (wl-summary-update-mark number)) + (elmo-folder-open folder 'load-msgdb) + (elmo-folder-unmark-answered folder (list number)) + (elmo-folder-close folder)))) (wl-draft-hide cur-buf) (wl-draft-delete cur-buf))) (message ""))) @@ -1546,7 +1564,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (if (elmo-folder-append-buffer (wl-folder-get-elmo-folder (eword-decode-string (car fcc-list))) - (not wl-fcc-force-as-read)) + (and wl-fcc-force-as-read 'read)) (wl-draft-write-sendlog 'ok 'fcc nil (car fcc-list) id) (wl-draft-write-sendlog 'failed 'fcc nil (car fcc-list) id)) (setq fcc-list (cdr fcc-list))))) @@ -1956,6 +1974,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (funcall wl-draft-buffer-style buffer) (error "Invalid value for wl-draft-buffer-style"))))) (set-buffer buffer) + (setq wl-draft-parent-folder "") (insert-file-contents-as-binary file-name) (elmo-delete-cr-buffer) (let((mime-edit-again-ignored-field-regexp @@ -2270,7 +2289,7 @@ Automatically applied in draft sending time." (let ((send-buffer (current-buffer)) (folder (wl-folder-get-elmo-folder wl-queue-folder)) (message-id (std11-field-body "Message-ID"))) - (if (elmo-folder-append-buffer folder t) + (if (elmo-folder-append-buffer folder) (progn (wl-draft-queue-info-operation (car (elmo-folder-status folder)) diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 591cce3..3bdd11a 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -120,8 +120,8 @@ wl-summary-jump-to-current-message t "Jump to Current Message"] [wl-summary-sync-force-update wl-summary-sync-force-update t "Sync Current Folder"] - [wl-summary-delete - wl-summary-delete t "Delete Current Message"] + [wl-summary-dispose + wl-summary-dispose t "Dispose Current Message"] [wl-summary-mark-as-important wl-summary-mark-as-important t "Mark Current Message as Important"] [wl-draft diff --git a/wl/wl-expire.el b/wl/wl-expire.el index e579713..588249e 100644 --- a/wl/wl-expire.el +++ b/wl/wl-expire.el @@ -88,30 +88,46 @@ (wl-expire-make-sortable-date datevec) (wl-expire-make-sortable-date key-datevec))))) -(defun wl-expire-delete-reserve-marked-msgs-from-list (msgs mark-alist) +;; New functions to avoid accessing to the msgdb directly. +(defsubst wl-expire-message-p (folder number) + "Return non-nil when a message in the FOLDER with NUMBER can be expired." + (cond ((consp wl-summary-expire-reserve-marks) + (let ((mark (elmo-message-mark folder number))) + (not (or (member mark wl-summary-expire-reserve-marks) + (and wl-summary-buffer-disp-msg + (eq number wl-summary-buffer-current-msg)))))) + ((eq wl-summary-expire-reserve-marks 'all) + (not (or (elmo-message-mark folder number) + (and wl-summary-buffer-disp-msg + (eq number wl-summary-buffer-current-msg))))) + ((eq wl-summary-expire-reserve-marks 'none) + t) + (t + (error "Invalid marks: %s" wl-summary-expire-reserve-marks)))) + +(defun wl-expire-delete-reserved-messages (msgs folder) + "Delete a number from NUMBERS when a message with the number is reserved." (let ((dlist msgs)) (while dlist - (unless (wl-expire-msg-p (car dlist) mark-alist) + (unless (wl-expire-message-p folder (car dlist)) (setq msgs (delq (car dlist) msgs))) (setq dlist (cdr dlist))) msgs)) +;; End New functions. -(defun wl-expire-delete (folder delete-list msgdb &optional no-reserve-marks) +(defun wl-expire-delete (folder delete-list &optional no-reserve-marks) "Delete message for expire." (unless no-reserve-marks (setq delete-list - (wl-expire-delete-reserve-marked-msgs-from-list - delete-list (elmo-msgdb-get-mark-alist msgdb)))) + (wl-expire-delete-reserved-messages delete-list folder))) (when delete-list (let ((mess (format "Expiring (delete) %s msgs..." (length delete-list)))) (message "%s" mess) - (if (elmo-folder-delete-messages folder - delete-list) + (if (elmo-folder-delete-messages folder delete-list) (progn - (elmo-msgdb-delete-msgs (elmo-folder-msgdb folder) - delete-list) + (elmo-folder-detach-messages folder delete-list) (wl-expire-append-log (elmo-folder-name-internal folder) delete-list nil 'delete) @@ -119,14 +135,13 @@ (error "%sfailed!" mess)))) (cons delete-list (length delete-list))) -(defun wl-expire-refile (folder refile-list msgdb dst-folder +(defun wl-expire-refile (folder refile-list dst-folder &optional no-reserve-marks preserve-number copy) "Refile message for expire. If COPY is non-nil, copy message." (when (not (string= (elmo-folder-name-internal folder) dst-folder)) (unless no-reserve-marks (setq refile-list - (wl-expire-delete-reserve-marked-msgs-from-list - refile-list (elmo-msgdb-get-mark-alist msgdb)))) + (wl-expire-delete-reserved-messages refile-list folder))) (when refile-list (let* ((doingmes (if copy "Copying %s" @@ -145,11 +160,10 @@ (if (elmo-folder-move-messages folder refile-list dst-folder - msgdb + nil ; XXX t copy preserve-number - nil wl-expire-add-seen-list) (progn (wl-expire-append-log @@ -162,15 +176,12 @@ (cons refile-list (length refile-list)))) (defun wl-expire-refile-with-copy-reserve-msg - (folder refile-list msgdb dst-folder + (folder refile-list dst-folder &optional no-reserve-marks preserve-number copy) "Refile message for expire. If REFILE-LIST includes reserve mark message, so copy." (when (not (string= (elmo-folder-name-internal folder) dst-folder)) (let ((msglist refile-list) - (mark-alist (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))) - (number-alist (elmo-msgdb-get-number-alist (elmo-folder-msgdb - folder))) (dst-folder (wl-folder-get-elmo-folder dst-folder)) (ret-val t) (copy-reserve-message) @@ -185,15 +196,16 @@ If REFILE-LIST includes reserve mark message, so copy." (error "%s: create folder failed" (elmo-folder-name-internal dst-folder))) (while (setq msg (wl-pop msglist)) - (unless (wl-expire-msg-p msg mark-alist) - (setq msg-id (cdr (assq msg number-alist))) + (unless (wl-expire-message-p msg folder) + (setq msg-id (elmo-message-field folder msg 'message-id)) (if (assoc msg-id wl-expired-alist) ;; reserve mark message already refiled or expired (setq refile-list (delq msg refile-list)) ;; reserve mark message not refiled - (wl-append wl-expired-alist (list (cons msg-id - (elmo-folder-name-internal - dst-folder)))) + (wl-append wl-expired-alist (list + (cons msg-id + (elmo-folder-name-internal + dst-folder)))) (setq copy-reserve-message t)))) (when refile-list (unless @@ -201,11 +213,10 @@ If REFILE-LIST includes reserve mark message, so copy." (elmo-folder-move-messages folder refile-list dst-folder - msgdb + nil ; t copy-reserve-message preserve-number - nil wl-expire-add-seen-list)) (error "Expire: move msgs to %s failed" (elmo-folder-name-internal dst-folder))) @@ -216,16 +227,12 @@ If REFILE-LIST includes reserve mark message, so copy." (setq copy-len (length refile-list)) (when copy-reserve-message (setq refile-list - (wl-expire-delete-reserve-marked-msgs-from-list - refile-list - mark-alist)) + (wl-expire-delete-reserved-messages refile-list folder)) (when refile-list (if (setq ret-val - (elmo-folder-delete-messages folder - refile-list)) + (elmo-folder-delete-messages folder refile-list)) (progn - (elmo-msgdb-delete-msgs (elmo-folder-msgdb folder) - refile-list) + (elmo-folder-detach-messages folder refile-list) (wl-expire-append-log (elmo-folder-name-internal folder) refile-list nil 'delete)))))) @@ -289,7 +296,7 @@ If REFILE-LIST includes reserve mark message, so copy." (setq files (cdr files)))))) (defun wl-expire-archive-number-delete-old (dst-folder-base - preserve-number msgs mark-alist + preserve-number msgs folder &optional no-confirm regexp file) (let ((len 0) (max-num 0) folder-info dels) @@ -308,10 +315,10 @@ If REFILE-LIST includes reserve mark message, so copy." (while (and msgs (>= max-num (car msgs))) (wl-append dels (list (car msgs))) (setq msgs (cdr msgs))) - (setq dels (wl-expire-delete-reserve-marked-msgs-from-list - dels mark-alist)) + (setq dels (wl-expire-delete-reserved-messages dels folder)) (unless (and dels - (or (or no-confirm (not wl-expire-delete-oldmsg-confirm)) + (or (or no-confirm (not + wl-expire-delete-oldmsg-confirm)) (progn (if (eq major-mode 'wl-summary-mode) (wl-thread-jump-to-msg (car dels))) @@ -321,7 +328,7 @@ If REFILE-LIST includes reserve mark message, so copy." (list msgs dels max-num (cdr folder-info) len)) (list msgs dels 0 "0" 0)))) -(defun wl-expire-archive-number1 (folder delete-list msgdb +(defun wl-expire-archive-number1 (folder delete-list &optional preserve-number dst-folder-arg no-delete) "Standard function for `wl-summary-expire'. @@ -344,11 +351,11 @@ Refile to archive folder followed message number." deleted-list ret-val) (setq tmp (wl-expire-archive-number-delete-old dst-folder-base preserve-number delete-list - (elmo-msgdb-get-mark-alist msgdb) + folder no-delete)) (when (and (not no-delete) (setq dels (nth 1 tmp))) - (wl-append deleted-list (car (wl-expire-delete folder dels msgdb)))) + (wl-append deleted-list (car (wl-expire-delete folder dels)))) (setq delete-list (car tmp)) (catch 'done (while t @@ -362,7 +369,7 @@ Refile to archive folder followed message number." (and (setq ret-val (funcall refile-func - folder arcmsg-list msgdb dst-folder t preserve-number + folder arcmsg-list dst-folder t preserve-number no-delete)) (wl-append deleted-list (car ret-val))) (setq arcmsg-list nil)) @@ -372,7 +379,7 @@ Refile to archive folder followed message number." (setq prev-arcnum arcnum))) deleted-list)) -(defun wl-expire-archive-number2 (folder delete-list msgdb +(defun wl-expire-archive-number2 (folder delete-list &optional preserve-number dst-folder-arg no-delete) "Standard function for `wl-summary-expire'. @@ -396,11 +403,11 @@ Refile to archive folder followed the number of message in one archive folder." deleted-list ret-val) (setq tmp (wl-expire-archive-number-delete-old dst-folder-base preserve-number delete-list - (elmo-msgdb-get-mark-alist msgdb) + folder no-delete)) (when (and (not no-delete) (setq dels (nth 1 tmp))) - (wl-append deleted-list (car (wl-expire-delete folder dels msgdb)))) + (wl-append deleted-list (car (wl-expire-delete folder dels)))) (setq delete-list (car tmp) filenum (string-to-int (nth 3 tmp)) len (nth 4 tmp) @@ -416,7 +423,7 @@ Refile to archive folder followed the number of message in one archive folder." (and (setq ret-val (funcall refile-func - folder arcmsg-list msgdb dst-folder t preserve-number + folder arcmsg-list dst-folder t preserve-number no-delete)) (wl-append deleted-list (car ret-val))) (setq arc-len (+ arc-len (cdr ret-val)))) @@ -432,14 +439,12 @@ Refile to archive folder followed the number of message in one archive folder." (wl-append arcmsg-list (list msg)))) deleted-list)) -(defun wl-expire-archive-date (folder delete-list msgdb +(defun wl-expire-archive-date (folder delete-list &optional preserve-number dst-folder-arg no-delete) "Standard function for `wl-summary-expire'. Refile to archive folder followed message date." (let* ((elmo-archive-treat-file t) ;; treat archive folder as a file. - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (overview (elmo-msgdb-get-overview msgdb)) (dst-folder-expand (and dst-folder-arg (wl-expand-newtext dst-folder-arg @@ -460,16 +465,15 @@ Refile to archive folder followed message date." deleted-list ret-val) (setq tmp (wl-expire-archive-number-delete-old dst-folder-base preserve-number delete-list - (elmo-msgdb-get-mark-alist msgdb) + folder no-delete wl-expire-archive-date-folder-num-regexp)) (when (and (not no-delete) (setq dels (nth 1 tmp))) - (wl-append deleted-list (car (wl-expire-delete folder dels msgdb)))) + (wl-append deleted-list (car (wl-expire-delete folder dels)))) (setq delete-list (car tmp)) (while (setq msg (wl-pop delete-list)) - (setq date (elmo-msgdb-overview-entity-get-date - (assoc (cdr (assq msg number-alist)) overview))) + (setq date (elmo-message-field folder msg 'date)) (setq time (condition-case nil (timezone-fix-time date nil nil) @@ -491,7 +495,7 @@ Refile to archive folder followed message date." (and (setq ret-val (funcall refile-func - folder arcmsg-list msgdb dst-folder t preserve-number + folder arcmsg-list dst-folder t preserve-number no-delete)) (wl-append deleted-list (car ret-val))) (setq arcmsg-alist (cdr arcmsg-alist))) @@ -529,15 +533,13 @@ Refile to archive folder followed message date." (format fmt dst-folder-base)) (cons dst-folder-base dst-folder-fmt))) -(defun wl-expire-localdir-date (folder delete-list msgdb +(defun wl-expire-localdir-date (folder delete-list &optional preserve-number dst-folder-arg no-delete) "Function for `wl-summary-expire'. Refile to localdir folder by message date. ex. +ml/wl/1999_11/, +ml/wl/1999_12/." - (let* ((number-alist (elmo-msgdb-get-number-alist msgdb)) - (overview (elmo-msgdb-get-overview msgdb)) - (dst-folder-expand (and dst-folder-arg + (let* ((dst-folder-expand (and dst-folder-arg (wl-expand-newtext dst-folder-arg (elmo-folder-name-internal folder)))) @@ -555,8 +557,7 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." msg arcmsg-alist arcmsg-list deleted-list ret-val) (while (setq msg (wl-pop delete-list)) - (setq date (elmo-msgdb-overview-entity-get-date - (assoc (cdr (assq msg number-alist)) overview))) + (setq date (elmo-message-field folder msg 'date)) (setq time (condition-case nil (timezone-fix-time date nil nil) @@ -578,22 +579,21 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." (and (setq ret-val (funcall refile-func - folder arcmsg-list msgdb dst-folder t preserve-number + folder arcmsg-list dst-folder t preserve-number no-delete)) (wl-append deleted-list (car ret-val))) (setq arcmsg-alist (cdr arcmsg-alist))) deleted-list)) -(defun wl-expire-hide (folder hide-list msgdb &optional no-reserve-marks) +(defun wl-expire-hide (folder hide-list &optional no-reserve-marks) "Hide message for expire." (unless no-reserve-marks (setq hide-list - (wl-expire-delete-reserve-marked-msgs-from-list - hide-list (elmo-msgdb-get-mark-alist msgdb)))) + (wl-expire-delete-reserved-messages hide-list folder))) (let ((mess (format "Hiding %s msgs..." (length hide-list)))) (message "%s" mess) - (elmo-msgdb-delete-msgs (elmo-folder-msgdb folder) hide-list) - (elmo-msgdb-append-to-killed-list folder hide-list) + (elmo-folder-detach-messages folder hide-list) + (elmo-folder-kill-messages folder hide-list) (elmo-folder-commit folder) (message "%sdone" mess) (cons hide-list (length hide-list)))) @@ -621,13 +621,8 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." (or (not (interactive-p)) (y-or-n-p (format "Expire %s? " (elmo-folder-name-internal folder))))) - (let* ((msgdb (or (wl-summary-buffer-msgdb) - (progn (elmo-folder-open folder 'load-msgdb) - (elmo-folder-msgdb folder)))) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (mark-alist (elmo-msgdb-get-mark-alist msgdb)) - expval rm-type val-type value more args - delete-list) + (let* (expval rm-type val-type value more args + delete-list) (save-excursion (setq expval (car expires) rm-type (nth 1 expires) @@ -641,34 +636,32 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." ((eq val-type 'number) (let* ((msgs (if (not nolist) (elmo-folder-list-messages folder) - (mapcar 'car number-alist))) + (elmo-folder-list-messages folder 'visible + 'in-msgdb))) (msglen (length msgs)) (more (or more (1+ value))) count) (when (>= msglen more) (setq count (- msglen value)) (while (and msgs (> count 0)) - (when (assq (car msgs) number-alist) ;; don't expire new message + (when (elmo-message-entity folder (car msgs)) + ;; don't expire new message (wl-append delete-list (list (car msgs))) (when (or (not wl-expire-number-with-reserve-marks) - (wl-expire-msg-p (car msgs) mark-alist)) + (wl-expire-message-p folder (car msgs))) (setq count (1- count)))) (setq msgs (cdr msgs)))))) ((eq val-type 'date) - (let* ((overview (elmo-msgdb-get-overview msgdb)) - (key-date (elmo-date-get-offset-datevec + (let* ((key-date (elmo-date-get-offset-datevec (timezone-fix-time (current-time-string) (current-time-zone) nil) value t))) - (while overview + (elmo-folder-do-each-message-entity (entity folder) (when (wl-expire-date-p key-date - (elmo-msgdb-overview-entity-get-date - (car overview))) + (elmo-message-entity-field entity 'date)) (wl-append delete-list - (list (elmo-msgdb-overview-entity-get-number - (car overview))))) - (setq overview (cdr overview))))) + (elmo-message-entity-number entity)))))) (t (error "%s: not supported" val-type))) (when delete-list @@ -681,21 +674,24 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." (cond ((eq rm-type nil) nil) ((eq rm-type 'remove) (setq deleting-info "Deleting...") - (car (wl-expire-delete folder delete-list msgdb))) + (car (wl-expire-delete folder delete-list))) ((eq rm-type 'trash) (setq deleting-info "Deleting...") - (car (wl-expire-refile folder delete-list msgdb wl-trash-folder))) + (car (wl-expire-refile folder + delete-list + wl-trash-folder))) ((eq rm-type 'hide) (setq deleting-info "Hiding...") - (car (wl-expire-hide folder delete-list msgdb))) + (car (wl-expire-hide folder delete-list))) ((stringp rm-type) (setq deleting-info "Refiling...") - (car (wl-expire-refile folder delete-list msgdb + (car (wl-expire-refile folder delete-list (wl-expand-newtext rm-type - (elmo-folder-name-internal folder))))) + (elmo-folder-name-internal + folder))))) ((fboundp rm-type) - (apply rm-type (append (list folder delete-list msgdb) + (apply rm-type (append (list folder delete-list) args))) (t (error "%s: invalid type" rm-type)))) @@ -783,28 +779,28 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." wl-folder-entity)) (message "Archiving %s is done" entity-name)))) -(defun wl-archive-number1 (folder archive-list msgdb &optional dst-folder-arg) - (wl-expire-archive-number1 folder archive-list msgdb t dst-folder-arg t)) +(defun wl-archive-number1 (folder archive-list &optional dst-folder-arg) + (wl-expire-archive-number1 folder archive-list t dst-folder-arg t)) -(defun wl-archive-number2 (folder archive-list msgdb &optional dst-folder-arg) - (wl-expire-archive-number2 folder archive-list msgdb t dst-folder-arg t)) +(defun wl-archive-number2 (folder archive-list &optional dst-folder-arg) + (wl-expire-archive-number2 folder archive-list t dst-folder-arg t)) -(defun wl-archive-date (folder archive-list msgdb &optional dst-folder-arg) - (wl-expire-archive-date folder archive-list msgdb t dst-folder-arg t)) +(defun wl-archive-date (folder archive-list &optional dst-folder-arg) + (wl-expire-archive-date folder archive-list t dst-folder-arg t)) -(defun wl-archive-folder (folder archive-list msgdb dst-folder) +(defun wl-archive-folder (folder archive-list dst-folder) (let* ((elmo-archive-treat-file t) ;; treat archive folder as a file. copied-list ret-val) (setq archive-list (car (wl-expire-archive-number-delete-old nil t archive-list - (elmo-msgdb-get-mark-alist msgdb) + folder t ;; no-confirm nil dst-folder))) (when archive-list (and (setq ret-val (wl-expire-refile - folder archive-list msgdb dst-folder t t t)) ;; copy!! + folder archive-list dst-folder t t t)) ;; copy!! (wl-append copied-list ret-val))) copied-list)) @@ -812,11 +808,9 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." "" (interactive "P") (let* ((folder (or folder wl-summary-buffer-elmo-folder)) - (msgdb (or (wl-summary-buffer-msgdb) - (elmo-msgdb-load folder))) (msgs (if (not nolist) (elmo-folder-list-messages folder) - (mapcar 'car (elmo-msgdb-get-number-alist msgdb)))) + (elmo-folder-list-messages folder 'visible 'in-msgdb))) (alist wl-archive-alist) archives func args dst-folder archive-list) (if arg @@ -830,7 +824,7 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." "for archive")))) (run-hooks 'wl-summary-archive-pre-hook) (if dst-folder - (wl-archive-folder folder msgs msgdb dst-folder) + (wl-archive-folder folder msgs dst-folder) (when (and (or (setq archives (wl-archive-folder-p (elmo-folder-name-internal folder))) (progn (and (interactive-p) @@ -843,7 +837,7 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." (setq func (car archives) args (cdr archives)) (setq archive-list - (apply func (append (list folder msgs msgdb) args))) + (apply func (append (list folder msgs) args))) (run-hooks 'wl-summary-archive-hook) (if archive-list (message "Archiving %s is done" (elmo-folder-name-internal folder)) diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el index 4e38b40..caced28 100644 --- a/wl/wl-fldmgr.el +++ b/wl/wl-fldmgr.el @@ -387,11 +387,11 @@ return value is diffs '(-new -unread -all)." (cond ((stringp (car new2)) ;; folder (cond - ((wl-string-member (car new2) flist) + ((elmo-string-member (car new2) flist) (and errmes (message "%s: already exists" (car new2))) (throw 'success nil)) ((and access - (not (wl-string-member (car new2) unsubscribes))) + (not (elmo-string-member (car new2) unsubscribes))) (and errmes (message "%s: not access group folder" (car new2))) (throw 'success nil)))) (t ;; group diff --git a/wl/wl-folder.el b/wl/wl-folder.el index 5e74d02..f749b69 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -810,7 +810,7 @@ Optional argument ARG is repeart count." (t (message "Uncheck(unplugged) \"%s\"" entity))))) (if ret-val - (message "Checking \"%s\" is done." + (message "Checking \"%s\" is done" (if (consp entity) (car entity) entity))) (run-hooks 'wl-folder-check-entity-hook) ret-val)) @@ -825,8 +825,10 @@ Optional argument ARG is repeart count." (elmo-folder-diff folder))) (error ;; maybe not exist folder. - (if (and (not (memq 'elmo-open-error - (get (car err) 'error-conditions))) + (if (and (not (or (memq 'elmo-open-error + (get (car err) 'error-conditions)) + (memq 'elmo-imap4-bye-error + (get (car err) 'error-conditions)))) (not (elmo-folder-exists-p folder))) (wl-folder-create-subr folder) (signal (car err) (cdr err)))))) @@ -850,7 +852,7 @@ Optional argument ARG is repeart count." all (and all (max 0 all)))) (setq unread (or (and unread (- unread (or new 0))) (elmo-folder-get-info-unread folder) - (cdr (wl-summary-count-unread)))) + (nth 1 (elmo-folder-count-flags folder)))) (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity (list new unread all) (get-buffer wl-folder-buffer-name))) @@ -1095,7 +1097,8 @@ If current line is group folder, all subfolders are marked." (group (wl-folder-buffer-group-p)) summary-buf) (when (and entity-name - (y-or-n-p (format "Mark all messages in %s as read? " entity-name))) + (y-or-n-p (format "Mark all messages in %s as read? " + entity-name))) (wl-folder-mark-as-read-all-entity (if group (wl-folder-search-group-entity-by-name entity-name diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index 31a47cc..ef60fbf 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -250,7 +250,7 @@ :group 'wl-summary-faces :group 'wl-faces) -(wl-defface wl-highlight-summary-deleted-face +(wl-defface wl-highlight-summary-disposed-face '( (((type tty) (background dark)) @@ -261,10 +261,55 @@ (((class color) (background light)) (:foreground "DarkKhaki"))) + "Face used for displaying messages mark as disposed." + :group 'wl-summary-faces + :group 'wl-faces) + +(wl-defface wl-highlight-summary-deleted-face + '( + (((type tty) + (background dark)) + (:foreground "blue")) + (((class color) + (background dark)) + (:foreground "SteelBlue")) + (((class color) + (background light)) + (:foreground "RoyalBlue4"))) "Face used for displaying messages mark as deleted." :group 'wl-summary-faces :group 'wl-faces) +(wl-defface wl-highlight-summary-prefetch-face + '( + (((type tty) + (background dark)) + (:foreground "Green")) + (((class color) + (background dark)) + (:foreground "DeepSkyBlue")) + (((class color) + (background light)) + (:foreground "brown"))) + "Face used for displaying messages mark as deleted." + :group 'wl-summary-faces + :group 'wl-faces) + +(wl-defface wl-highlight-summary-resend-face + '( + (((type tty) + (background dark)) + (:foreground "Yellow")) + (((class color) + (background dark)) + (:foreground "orange3")) + (((class color) + (background light)) + (:foreground "orange3"))) + "Face used for displaying messages mark as resend." + :group 'wl-summary-faces + :group 'wl-faces) + (wl-defface wl-highlight-summary-refiled-face '( (((type tty) @@ -295,6 +340,21 @@ :group 'wl-summary-faces :group 'wl-faces) +;; answered +(wl-defface wl-highlight-summary-answered-face + '((((type tty) + (background dark)) + (:foreground "yellow")) + (((class color) + (background dark)) + (:foreground "khaki")) + (((class color) + (background light)) + (:foreground "khaki4"))) + "Face used for displaying answered messages." + :group 'wl-summary-faces + :group 'wl-faces) + ;; obsolete. (wl-defface wl-highlight-summary-temp-face '( @@ -561,14 +621,14 @@ "Face used for displaying demo." :group 'wl-faces) -(wl-defface wl-highlight-refile-destination-face +(wl-defface wl-highlight-action-argument-face '((((class color) (background dark)) (:foreground "pink")) (((class color) (background light)) (:foreground "red"))) - "Face used for displaying refile destination." + "Face used for displaying action argument." :group 'wl-summary-faces :group 'wl-faces) @@ -761,31 +821,28 @@ (put-text-property bol eol 'face text-face))))) (defun wl-highlight-summary-line-string (line mark temp-mark indent) - (let (fsymbol) + (let (fsymbol action) (cond ((and (string= temp-mark wl-summary-score-over-mark) - (member mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark))) + (member mark (list elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-new-mark))) (setq fsymbol 'wl-highlight-summary-high-unread-face)) ((and (string= temp-mark wl-summary-score-below-mark) - (member mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark))) + (member mark (list elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-new-mark))) (setq fsymbol 'wl-highlight-summary-low-unread-face)) - ((string= temp-mark "o") - (setq fsymbol 'wl-highlight-summary-refiled-face)) - ((string= temp-mark "O") - (setq fsymbol 'wl-highlight-summary-copied-face)) - ((string= temp-mark "D") - (setq fsymbol 'wl-highlight-summary-deleted-face)) - ((string= temp-mark "*") - (setq fsymbol 'wl-highlight-summary-temp-face)) - ((string= mark wl-summary-new-mark) + ((setq action (assoc temp-mark wl-summary-mark-action-list)) + (setq fsymbol (nth 5 action))) + ((string= mark elmo-msgdb-new-mark) (setq fsymbol 'wl-highlight-summary-new-face)) - ((member mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark)) + ((member mark (list elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark)) (setq fsymbol 'wl-highlight-summary-unread-face)) - ((or (string= mark wl-summary-important-mark)) + ((member mark (list elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark)) + (setq fsymbol 'wl-highlight-summary-answered-face)) + ((or (string= mark elmo-msgdb-important-mark)) (setq fsymbol 'wl-highlight-summary-important-face)) ((string= temp-mark wl-summary-score-below-mark) (setq fsymbol 'wl-highlight-summary-low-read-face)) @@ -804,42 +861,37 @@ (let ((inhibit-read-only t) (case-fold-search nil) temp-mark status-mark (deactivate-mark nil) - fsymbol bol eol matched thread-top looked-at dest ds) + fsymbol action bol eol matched thread-top looked-at dest ds) (end-of-line) (setq eol (point)) (beginning-of-line) (setq bol (point)) (setq status-mark (wl-summary-persistent-mark)) (setq temp-mark (wl-summary-temp-mark)) - (cond - ((string= temp-mark "*") - (setq fsymbol 'wl-highlight-summary-temp-face)) - ((string= temp-mark "D") - (setq fsymbol 'wl-highlight-summary-deleted-face)) - ((string= temp-mark "O") - (setq fsymbol 'wl-highlight-summary-copied-face - dest t)) - ((string= temp-mark "o") - (setq fsymbol 'wl-highlight-summary-refiled-face - dest t))) + (when (setq action (assoc temp-mark wl-summary-mark-action-list)) + (setq fsymbol (nth 5 action)) + (setq dest (nth 2 action))) (if (not fsymbol) (cond ((and (string= temp-mark wl-summary-score-over-mark) - (member status-mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark))) + (member status-mark (list elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-new-mark))) (setq fsymbol 'wl-highlight-summary-high-unread-face)) ((and (string= temp-mark wl-summary-score-below-mark) - (member status-mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark))) + (member status-mark (list elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-new-mark))) (setq fsymbol 'wl-highlight-summary-low-unread-face)) - ((string= status-mark wl-summary-new-mark) + ((string= status-mark elmo-msgdb-new-mark) (setq fsymbol 'wl-highlight-summary-new-face)) - ((member status-mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark)) + ((member status-mark (list elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark)) (setq fsymbol 'wl-highlight-summary-unread-face)) - ((string= status-mark wl-summary-important-mark) + ((member status-mark (list elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark)) + (setq fsymbol 'wl-highlight-summary-answered-face)) + ((string= status-mark elmo-msgdb-important-mark) (setq fsymbol 'wl-highlight-summary-important-face)) ;; score mark ((string= temp-mark wl-summary-score-below-mark) @@ -856,20 +908,15 @@ (when dest (put-text-property (next-single-property-change (next-single-property-change - bol 'wl-summary-destination + bol 'wl-summary-action-argument nil eol) - 'wl-summary-destination nil eol) + 'wl-summary-action-argument nil eol) eol 'face - 'wl-highlight-refile-destination-face)) + 'wl-highlight-action-argument-face)) (if wl-use-highlight-mouse-line (put-text-property bol -;;; Use bol instead of (1- (match-end 0)) -;;; (1- (match-end 0)) eol 'mouse-face 'highlight)) -;;; (put-text-property (match-beginning 3) (match-end 3) -;;; 'face 'wl-highlight-thread-indent-face) - ;; Dnd stuff. (if wl-use-dnd (wl-dnd-set-drag-starter bol eol))))) @@ -927,9 +974,9 @@ Variables used: (overlay-put ov 'wl-momentary-overlay t)) (forward-line 1))))) -(defun wl-highlight-refile-destination-string (string) +(defun wl-highlight-action-argument-string (string) (put-text-property 0 (length string) 'face - 'wl-highlight-refile-destination-face + 'wl-highlight-action-argument-face string)) (defun wl-highlight-summary-all () diff --git a/wl/wl-message.el b/wl/wl-message.el index 0ba6843..4a243eb 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -595,18 +595,14 @@ Returns non-nil if bottom of message." 'wl-message-buffer-prefetch-subr folder number count summary charset))) -(defvar wl-message-buffer-prefetch-move-spec-plugged-alist nil) -(defvar wl-message-buffer-prefetch-move-spec-unplugged-alist nil) +(defvar wl-message-buffer-prefetch-move-spec-alist nil) (defun wl-message-buffer-prefetch-get-next (folder number summary) (if (buffer-live-p summary) (with-current-buffer summary - (let ((wl-summary-move-spec-plugged-alist - (or wl-message-buffer-prefetch-move-spec-plugged-alist - wl-summary-move-spec-plugged-alist)) - (wl-summary-move-spec-unplugged-alist - (or wl-message-buffer-prefetch-move-spec-unplugged-alist - wl-summary-move-spec-unplugged-alist)) + (let ((wl-summary-move-spec-alist + (or wl-message-buffer-prefetch-move-spec-alist + wl-summary-move-spec-alist)) (next number)) (while (and (setq next (funcall wl-message-buffer-prefetch-get-next-function diff --git a/wl/wl-mime.el b/wl/wl-mime.el index 379352c..d6f467b 100644 --- a/wl/wl-mime.el +++ b/wl/wl-mime.el @@ -278,7 +278,7 @@ It calls following-method selected from variable (goto-char header-start) (insert "Content-Type: text/plain; charset=US-ASCII\n\n") (insert "** This part has been removed by Wanderlust **\n\n") - (elmo-folder-append-buffer folder t)) + (elmo-folder-append-buffer folder)) (elmo-folder-move-messages folder (list number) @@ -311,59 +311,49 @@ It calls following-method selected from variable (message "Cannot find pgp encrypted region"))) (message "Cannot find pgp encrypted region")))) -(defun wl-message-verify-pgp-nonmime (&optional arg) - "Verify PGP signed region. -With ARG, ask coding system and encode the region with it before verifying." - (interactive "P") +(defun wl-message-verify-pgp-nonmime () + "Verify PGP signed region" + (interactive) (require 'pgg) (save-excursion (beginning-of-line) - (let ((msg-buf (current-buffer)) - beg end status m-beg) - (if (and (when (or (re-search-forward "^-+END PGP SIGNATURE-+$" nil t) - (re-search-backward "^-+END PGP SIGNATURE-+$" nil t)) - (setq end (match-end 0))) - (setq beg (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))) - (progn - (if arg - (with-temp-buffer - (insert-buffer-substring msg-buf beg end) - (set-mark (point-min)) - (goto-char (point-max)) - (call-interactively 'encode-coding-region) - (setq status (pgg-verify-region (point-min) (point-max) nil 'fetch))) - (let* ((situation (mime-preview-find-boundary-info)) - (p-end (aref situation 1)) - (entity (aref situation 2)) - (count 0)) - (goto-char p-end) - (while (< beg (point)) - (if (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t) - (setq count (+ count 1)) - (debug))) - (with-temp-buffer - (insert (mime-entity-body entity)) - (goto-char (point-max)) - (while (> count 0) - (if (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t) - (setq count (- count 1)) - (debug))) - (let ((r-beg (point)) - (r-end (re-search-forward "^-+END PGP SIGNATURE-+$" nil t))) - (if r-end - (setq status (pgg-verify-region r-beg r-end nil 'fetch)) - (debug)))))) - (mime-show-echo-buffer) - (set-buffer mime-echo-buffer-name) - (set-window-start - (get-buffer-window mime-echo-buffer-name) - (point-max)) - (setq m-beg (point)) - (insert-buffer-substring - (if status pgg-output-buffer pgg-errors-buffer)) - (encode-coding-region m-beg (point) buffer-file-coding-system) - (decode-coding-region m-beg (point) wl-cs-autoconv)) - (message "Cannot find pgp signed region"))))) + (if (and (or (re-search-forward "^-+END PGP SIGNATURE-+$" nil t) + (re-search-backward "^-+END PGP SIGNATURE-+$" nil t)) + (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)) + (let (status m-beg) + (let* ((beg (point)) + (situation (mime-preview-find-boundary-info)) + (p-end (aref situation 1)) + (entity (aref situation 2)) + (count 0)) + (goto-char p-end) + (while (< beg (point)) + (if (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t) + (setq count (+ count 1)) + (debug))) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert (mime-entity-body entity)) + (goto-char (point-max)) + (while (> count 0) + (if (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t) + (setq count (- count 1)) + (debug))) + (let ((r-beg (point)) + (r-end (re-search-forward "^-+END PGP SIGNATURE-+$" nil t))) + (if r-end + (setq status (pgg-verify-region r-beg r-end nil 'fetch)) + (debug))))) + (mime-show-echo-buffer) + (set-buffer mime-echo-buffer-name) + (set-window-start + (get-buffer-window mime-echo-buffer-name) + (point-max)) + (setq m-beg (point)) + (insert-buffer-substring + (if status pgg-output-buffer pgg-errors-buffer)) + (decode-coding-region m-beg (point) wl-cs-autoconv)) + (message "Cannot find pgp signed region")))) ;; XXX: encrypted multipart isn't represented as multipart (defun wl-mime-preview-application/pgp (parent-entity entity situation) @@ -426,9 +416,7 @@ With ARG, ask coding system and encode the region with it before verifying." (car (mime-entity-children message-entity))) (with-temp-buffer (insert (mime-entity-body message-entity)) - (elmo-folder-append-buffer - target - (mime-entity-fetch-field entity "Message-ID"))))) + (elmo-folder-append-buffer target)))) number)) (defun wl-summary-burst (&optional arg) @@ -481,9 +469,9 @@ With ARG, ask destination folder." (defun wl-mime-combine-message/partial-pieces (entity situation) "Internal method for wl to combine message/partial messages automatically." (interactive) - (let* ((msgdb (save-excursion - (set-buffer wl-message-buffer-cur-summary-buffer) - (wl-summary-buffer-msgdb))) + (let* ((folder (save-excursion + (set-buffer wl-message-buffer-cur-summary-buffer) + wl-summary-buffer-elmo-folder)) (mime-display-header-hook 'wl-highlight-headers) (folder wl-message-buffer-cur-folder) (id (or (cdr (assoc "id" situation)) "")) @@ -516,18 +504,16 @@ With ARG, ask destination folder." wl-summary-buffer-mime-charset))) (if (string-match "[0-9\n]+" subject-id) (setq subject-id (substring subject-id 0 (match-beginning 0)))) - (setq overviews (elmo-msgdb-get-overview msgdb)) (catch 'tag - (while overviews + (elmo-folder-do-each-message-entity (entity folder) (when (string-match (regexp-quote subject-id) - (elmo-msgdb-overview-entity-get-subject (car overviews))) + (elmo-message-entity-field entity 'subject)) (let* ((message ;; request message at the cursor in Subject buffer. (wl-message-request-partial folder - (elmo-msgdb-overview-entity-get-number - (car overviews)))) + (elmo-message-entity-number entity))) (situation (mime-entity-situation message)) (the-id (or (cdr (assoc "id" situation)) ""))) (when (string= (downcase the-id) @@ -535,8 +521,7 @@ With ARG, ask destination folder." (with-current-buffer mother (mime-store-message/partial-piece message situation)) (if (file-exists-p full-file) - (throw 'tag nil))))) - (setq overviews (cdr overviews))) + (throw 'tag nil)))))) (message "Not all partials found."))))) (defun wl-mime-display-text/plain (entity situation) diff --git a/wl/wl-news.el.in b/wl/wl-news.el.in index 7dd853e..4ca7839 100644 --- a/wl/wl-news.el.in +++ b/wl/wl-news.el.in @@ -173,7 +173,7 @@ (and (elmo-folder-writable-p (wl-folder-get-elmo-folder folder)) (elmo-folder-append-buffer - (wl-folder-get-elmo-folder folder) t))) + (wl-folder-get-elmo-folder folder)))) (wl-draft-hide send-buffer) (wl-draft-delete send-buffer)) ret)) diff --git a/wl/wl-refile.el b/wl/wl-refile.el index 6156774..9d78fb6 100644 --- a/wl/wl-refile.el +++ b/wl/wl-refile.el @@ -89,8 +89,8 @@ (downcase (wl-address-header-extract-address entity)))) (wl-parse-addresses (concat - (elmo-msgdb-overview-entity-get-to entity) "," - (elmo-msgdb-overview-entity-get-cc entity))))) + (elmo-message-entity-field entity 'to) "," + (elmo-message-entity-field entity 'cc))))) (while tocc-list (if (wl-string-member (car tocc-list) @@ -104,8 +104,7 @@ (setq from (downcase (wl-address-header-extract-address - (elmo-msgdb-overview-entity-get-from - entity))))) + (elmo-message-entity-field entity 'from))))) (setq key from)) (if (or wl-refile-msgid-alist (memq 'wl-refile-guess-by-msgid @@ -122,7 +121,7 @@ wl-refile-alist))))) (defun wl-refile-msgid-learn (entity dst) - (let ((key (elmo-msgdb-overview-entity-get-id entity)) + (let ((key (elmo-message-entity-field entity 'message-id)) hit) (setq dst (elmo-string dst)) (if key @@ -133,7 +132,7 @@ (defun wl-refile-subject-learn (entity dst) (let ((subject (funcall wl-summary-subject-filter-function - (elmo-msgdb-overview-entity-get-subject entity))) + (elmo-message-entity-field entity 'subject))) hit) (setq dst (elmo-string dst)) (if (and subject (not (string= subject ""))) @@ -199,15 +198,7 @@ If RULE does not match ENTITY, returns nil." (defun wl-refile-get-field-value (entity field) "Get FIELD value from ENTITY." - (let ((field (downcase field)) - (fixed-fields '("from" "subject" "to" "cc"))) - (if (member field fixed-fields) - (funcall (symbol-function - (intern (concat - "elmo-msgdb-overview-entity-get-" - field))) - entity) - (elmo-msgdb-overview-entity-get-extra-field entity field)))) + (elmo-message-entity-field entity (intern (downcase field)))) (defun wl-refile-guess-by-rule (entity) (let ((rules wl-refile-rule-alist) diff --git a/wl/wl-score.el b/wl/wl-score.el index a3eb67b..8fc34a5 100644 --- a/wl/wl-score.el +++ b/wl/wl-score.el @@ -164,13 +164,12 @@ Remove Re, Was, Fwd etc." ;; (defun wl-score-overview-entity-get-lines (entity) - (let ((lines - (elmo-msgdb-overview-entity-get-extra-field entity "lines"))) + (let ((lines (elmo-message-entity-field entity 'lines))) (and lines (string-to-int lines)))) (defun wl-score-overview-entity-get-xref (entity) - (or (elmo-msgdb-overview-entity-get-extra-field entity "xref") + (or (elmo-message-entity-field entity 'xref) "")) (defun wl-score-overview-entity-get-extra (entity header &optional decode) @@ -340,7 +339,7 @@ Set `wl-score-cache' nil." (defun wl-score-get-score-files (score-alist folder) (let ((files (wl-get-assoc-list-value - score-alist folder + score-alist (elmo-folder-name-internal folder) (if (not wl-score-folder-alist-matchone) 'all-list))) fl f) (while (setq f (wl-pop files)) @@ -352,11 +351,12 @@ Set `wl-score-cache' nil." (list f))))) fl)) -(defun wl-score-get-score-alist (&optional folder) +(defun wl-score-get-score-alist () (interactive) - (let* ((fld (or folder (wl-summary-buffer-folder-name))) - (score-alist (reverse - (wl-score-get-score-files wl-score-folder-alist fld))) + (let* ((score-alist (reverse + (wl-score-get-score-files + wl-score-folder-alist + wl-summary-buffer-elmo-folder))) alist scores) (setq wl-current-score-file nil) (unless (and wl-score-default-file @@ -390,32 +390,27 @@ Set `wl-score-cache' nil." (setq score-alist (cdr score-alist))) scores)) -(defun wl-score-headers (scores &optional msgdb force-msgs not-add) +(defun wl-score-headers (scores &optional force-msgs not-add) (let* ((elmo-mime-charset wl-summary-buffer-mime-charset) + (folder wl-summary-buffer-elmo-folder) (now (wl-day-number (current-time-string))) (expire (and wl-score-expiry-days (- now wl-score-expiry-days))) - (overview (elmo-msgdb-get-overview - (or msgdb (wl-summary-buffer-msgdb)))) - (mark-alist (elmo-msgdb-get-mark-alist - (or msgdb (wl-summary-buffer-msgdb)))) (wl-score-stop-add-entry not-add) entries news new num entry ov header) (setq wl-scores-messages nil) (message "Scoring...") - ;; Create messages, an alist of the form `(OVERVIEW . SCORE)'. - (while (setq ov (pop overview)) - (when (and (not (assq - (setq num - (elmo-msgdb-overview-entity-get-number ov)) - wl-summary-scored)) + ;; Create messages, an alist of the form `(ENTITY . SCORE)'. + (elmo-folder-do-each-message-entity (entity folder) + (setq num (elmo-message-entity-number entity)) + (when (and (not (assq num wl-summary-scored)) (or (memq num force-msgs) - (member (cadr (assq num mark-alist)) + (member (elmo-message-mark folder num) wl-summary-score-marks))) (setq wl-scores-messages - (cons (cons ov (or wl-summary-default-score 0)) + (cons (cons entity (or wl-summary-default-score 0)) wl-scores-messages)))) (save-excursion @@ -443,7 +438,7 @@ Set `wl-score-cache' nil." (while wl-scores-messages (when (or (/= wl-summary-default-score (cdar wl-scores-messages))) - (setq num (elmo-msgdb-overview-entity-get-number + (setq num (elmo-message-entity-number (caar wl-scores-messages)) score (cdar wl-scores-messages)) (if (setq entry (assq num wl-summary-scored)) @@ -786,8 +781,8 @@ Set `wl-score-cache' nil." (< expire (setq day (wl-day-number - (elmo-msgdb-overview-entity-get-date - (car art))))))) + (elmo-message-entity-field + (car art) 'date)))))) (when (setq new (wl-score-add-followups (car art) score all-scores alist thread day)) @@ -926,35 +921,32 @@ Set `wl-score-cache' nil." (let* ((now (wl-day-number (current-time-string))) (expire (and wl-score-expiry-days (- now wl-score-expiry-days))) - (roverview (reverse (elmo-msgdb-get-overview - (wl-summary-buffer-msgdb)))) + (rnumbers (reverse wl-summary-buffer-number-list)) msgs) (if (not expire) - (mapcar 'car (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb))) ;; all messages + (elmo-folder-list-messages wl-summary-buffer-elmo-folder + nil t) (catch 'break - (while roverview + (while rnumbers (if (< (wl-day-number - (elmo-msgdb-overview-entity-get-date (car roverview))) + (elmo-message-entity-field + (elmo-message-entity wl-summary-buffer-elmo-folder + (car rnumbers)) + 'date)) expire) (throw 'break t)) - (wl-push (elmo-msgdb-overview-entity-get-number (car roverview)) - msgs) - (setq roverview (cdr roverview)))) + (wl-push (car rnumbers) msgs) + (setq rnumbers (cdr rnumbers)))) msgs))) -(defsubst wl-score-get-overview () - (let ((num (wl-summary-message-number))) - (if num - (assoc (cdr (assq num (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb)))) - (elmo-msgdb-get-overview (wl-summary-buffer-msgdb)))))) - (defun wl-score-get-header (header &optional extra) (let ((index (nth 2 (assoc header wl-score-header-index))) (decode (nth 3 (assoc header wl-score-header-index)))) (if index - (wl-score-ov-entity-get (wl-score-get-overview) index extra decode)))) + (wl-score-ov-entity-get + (elmo-message-entity wl-summary-buffer-elmo-folder + (wl-summary-message-number)) + index extra decode)))) (defun wl-score-kill-help-buffer () (when (get-buffer "*Score Help*") @@ -1144,8 +1136,8 @@ Set `wl-score-cache' nil." (cond ((string= header "followup") (if wl-score-auto-make-followup-entry (let ((wl-score-make-followup t)) - (wl-score-headers scores nil (wl-score-get-latest-msgs))) - (wl-score-headers scores nil + (wl-score-headers scores (wl-score-get-latest-msgs))) + (wl-score-headers scores (if (eq wl-summary-buffer-view 'thread) (wl-thread-get-children-msgs (wl-summary-message-number)) @@ -1155,7 +1147,7 @@ Set `wl-score-cache' nil." "references" (cdr (assoc "references" (car scores)))))) ((string= header "thread") - (wl-score-headers scores nil + (wl-score-headers scores (if (eq wl-summary-buffer-view 'thread) (wl-thread-get-children-msgs (wl-summary-message-number)) @@ -1165,18 +1157,16 @@ Set `wl-score-cache' nil." ;; remove parent (cdr (cdaar scores))))) (t - (wl-score-headers scores nil + (wl-score-headers scores (list (wl-summary-message-number))))) (wl-summary-score-update-all-lines t))) -(defun wl-summary-rescore-msgs (number-alist) - (mapcar - 'car - (nthcdr - (max (- (length number-alist) - wl-summary-rescore-partial-threshold) - 0) - number-alist))) +(defun wl-summary-rescore-msgs (numbers) + (nthcdr + (max (- (length numbers) + wl-summary-rescore-partial-threshold) + 0) + numbers)) (defun wl-summary-rescore (&optional arg) "Redo the entire scoring process in the current summary." @@ -1185,22 +1175,21 @@ Set `wl-score-cache' nil." (wl-score-save) (setq wl-score-cache nil) (setq wl-summary-scored nil) - (setq number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))) - (wl-summary-score-headers nil (wl-summary-buffer-msgdb) - (unless arg - (wl-summary-rescore-msgs number-alist))) + (wl-summary-score-headers (unless arg + (wl-summary-rescore-msgs + (elmo-folder-list-messages + wl-summary-buffer-elmo-folder t t)))) (setq expunged (wl-summary-score-update-all-lines t)) (if expunged (message "%d message(s) are expunged by scoring." (length expunged))) (set-buffer-modified-p nil))) ;; optional argument force-msgs is added by teranisi. -(defun wl-summary-score-headers (&optional folder msgdb force-msgs not-add) +(defun wl-summary-score-headers (&optional force-msgs not-add) "Do scoring if scoring is required." - (let ((scores (wl-score-get-score-alist - (or folder (wl-summary-buffer-folder-name))))) + (let ((scores (wl-score-get-score-alist))) (when scores - (wl-score-headers scores msgdb force-msgs not-add)))) + (wl-score-headers scores force-msgs not-add)))) (defun wl-summary-score-update-all-lines (&optional update) (let* ((alist wl-summary-scored) @@ -1236,9 +1225,7 @@ Set `wl-score-cache' nil." ((and wl-summary-target-above (> score wl-summary-target-above)) (if visible - (wl-summary-mark-line "*")) - (setq wl-summary-buffer-target-mark-list - (cons num wl-summary-buffer-target-mark-list)))) + (wl-summary-set-mark "*")))) (setq alist (cdr alist)) (when (> count elmo-display-progress-threshold) (setq i (1+ i)) @@ -1246,27 +1233,23 @@ Set `wl-score-cache' nil." 'wl-summary-score-update-all-lines "Updating score..." (/ (* i 100) count)))) (when dels - (let ((marks dels)) - (while marks - (elmo-msgdb-set-mark (wl-summary-buffer-msgdb) - (pop marks) nil))) - (elmo-folder-mark-as-read wl-summary-buffer-elmo-folder - dels) + ;;(let ((marks dels)) + ;;(while marks + ;;(elmo-message-set-flag wl-summary-buffer-elmo-folder + ;; (pop marks) 'read))) + (elmo-folder-kill-messages wl-summary-buffer-elmo-folder dels) (wl-summary-delete-messages-on-buffer dels)) (when (and update update-unread) - (let ((num-db (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb))) - (mark-alist (elmo-msgdb-get-mark-alist - (wl-summary-buffer-msgdb)))) - ;; Update Folder mode - (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) - (list - 0 - (let ((pair - (wl-summary-count-unread))) - (+ (car pair) (cdr pair))) - (length num-db))) - (wl-summary-update-modeline))) + ;; Update Folder mode + (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) + (list + 0 + (let ((pair + (wl-summary-count-unread))) + (+ (car pair) (cdr pair))) + (elmo-folder-length + wl-summary-buffer-elmo-folder))) + (wl-summary-update-modeline)) (message "Updating score...done") dels))) diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 0c7db41..17370cd 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -77,18 +77,17 @@ (defvar wl-summary-buffer-disp-msg nil) (defvar wl-summary-buffer-disp-folder nil) -(defvar wl-summary-buffer-refile-list nil) -(defvar wl-summary-buffer-delete-list nil) +(defvar wl-summary-buffer-temp-mark-list nil) (defvar wl-summary-buffer-last-displayed-msg nil) (defvar wl-summary-buffer-current-msg nil) (defvar wl-summary-buffer-unread-count 0) (defvar wl-summary-buffer-new-count 0) +(defvar wl-summary-buffer-answered-count 0) (defvar wl-summary-buffer-mime-charset nil) (defvar wl-summary-buffer-weekday-name-lang nil) (defvar wl-summary-buffer-thread-indent-set-alist nil) (defvar wl-summary-buffer-view nil) (defvar wl-summary-buffer-message-modified nil) -(defvar wl-summary-buffer-mark-modified nil) (defvar wl-summary-buffer-thread-modified nil) (defvar wl-summary-buffer-number-column nil) @@ -98,7 +97,6 @@ (defvar wl-summary-buffer-persistent nil) (defvar wl-summary-buffer-thread-nodes nil) (defvar wl-summary-buffer-target-mark-list nil) -(defvar wl-summary-buffer-copy-list nil) (defvar wl-summary-buffer-prev-refile-destination nil) (defvar wl-summary-buffer-prev-copy-destination nil) (defvar wl-summary-buffer-saved-message nil) @@ -140,19 +138,17 @@ (make-variable-buffer-local 'wl-summary-search-buf-folder-name) (make-variable-buffer-local 'wl-summary-buffer-disp-msg) (make-variable-buffer-local 'wl-summary-buffer-disp-folder) -(make-variable-buffer-local 'wl-summary-buffer-refile-list) -(make-variable-buffer-local 'wl-summary-buffer-copy-list) (make-variable-buffer-local 'wl-summary-buffer-target-mark-list) -(make-variable-buffer-local 'wl-summary-buffer-delete-list) +(make-variable-buffer-local 'wl-summary-buffer-temp-mark-list) (make-variable-buffer-local 'wl-summary-buffer-last-displayed-msg) (make-variable-buffer-local 'wl-summary-buffer-unread-count) (make-variable-buffer-local 'wl-summary-buffer-new-count) +(make-variable-buffer-local 'wl-summary-buffer-answered-count) (make-variable-buffer-local 'wl-summary-buffer-mime-charset) (make-variable-buffer-local 'wl-summary-buffer-weekday-name-lang) (make-variable-buffer-local 'wl-summary-buffer-thread-indent-set) (make-variable-buffer-local 'wl-summary-buffer-view) (make-variable-buffer-local 'wl-summary-buffer-message-modified) -(make-variable-buffer-local 'wl-summary-buffer-mark-modified) (make-variable-buffer-local 'wl-summary-buffer-thread-modified) (make-variable-buffer-local 'wl-summary-buffer-number-column) (make-variable-buffer-local 'wl-summary-buffer-temp-mark-column) @@ -195,11 +191,6 @@ (defvar wl-temp-mark) (defvar wl-persistent-mark) -;; internal functions (dummy) -(unless (fboundp 'wl-summary-append-message-func-internal) - (defun wl-summary-append-message-func-internal (entity msgdb update - &optional force-insert))) - (defmacro wl-summary-sticky-buffer-name (name) (` (concat wl-summary-buffer-name ":" (, name)))) @@ -223,8 +214,8 @@ See also variable `wl-use-petname'." (wl-summary-buffer-folder-name)) (wl-address-user-mail-address-p from) (cond - ((and (setq tos (elmo-msgdb-overview-entity-get-to - wl-message-entity)) + ((and (setq tos (elmo-message-entity-field + wl-message-entity 'to t)) (not (string= "" tos))) (setq retval (concat "To:" @@ -242,8 +233,8 @@ See also variable `wl-use-petname'." to)))) (wl-parse-addresses tos) ",")))) - ((setq ng (elmo-msgdb-overview-entity-get-extra-field - wl-message-entity "newsgroups")) + ((setq ng (elmo-message-entity-field + wl-message-entity 'newsgroups)) (setq retval (concat "Ng:" ng))))) (if wl-use-petname (setq retval (or (funcall wl-summary-get-petname-function from) @@ -296,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] @@ -329,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] @@ -414,6 +405,7 @@ See also variable `wl-use-petname'." (define-key wl-summary-mode-map "\eE" 'wl-summary-resend-bounced-mail) (define-key wl-summary-mode-map "f" 'wl-summary-forward) (define-key wl-summary-mode-map "$" 'wl-summary-mark-as-important) + (define-key wl-summary-mode-map "&" 'wl-summary-mark-as-answered) (define-key wl-summary-mode-map "@" 'wl-summary-edit-addresses) (define-key wl-summary-mode-map "y" 'wl-summary-save) @@ -470,12 +462,12 @@ See also variable `wl-use-petname'." (define-key wl-summary-mode-map "o" 'wl-summary-refile) (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 "\M-O" 'wl-summary-copy-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) + (define-key wl-summary-mode-map "~" 'wl-summary-resend) ;; thread commands (define-key wl-summary-mode-map "t" (make-sparse-keymap)) @@ -485,7 +477,9 @@ See also variable `wl-use-petname'." (define-key wl-summary-mode-map "t*" 'wl-thread-target-mark) (define-key wl-summary-mode-map "to" 'wl-thread-refile) (define-key wl-summary-mode-map "tO" 'wl-thread-copy) - (define-key wl-summary-mode-map "td" 'wl-thread-delete) + (define-key wl-summary-mode-map "td" 'wl-thread-dispose) + (define-key wl-summary-mode-map "tD" 'wl-thread-delete) + (define-key wl-summary-mode-map "t~" 'wl-thread-resend) (define-key wl-summary-mode-map "tu" 'wl-thread-unmark) (define-key wl-summary-mode-map "t!" 'wl-thread-mark-as-unread) (define-key wl-summary-mode-map "t$" 'wl-thread-mark-as-important) @@ -495,14 +489,18 @@ See also variable `wl-use-petname'." ;; target-mark commands (define-key wl-summary-mode-map "m" (make-sparse-keymap)) (define-key wl-summary-mode-map "mi" 'wl-summary-target-mark-prefetch) - (define-key wl-summary-mode-map "mR" 'wl-summary-target-mark-mark-as-read) (define-key wl-summary-mode-map "mo" 'wl-summary-target-mark-refile) (define-key wl-summary-mode-map "mO" 'wl-summary-target-mark-copy) - (define-key wl-summary-mode-map "md" 'wl-summary-target-mark-delete) + (define-key wl-summary-mode-map "md" 'wl-summary-target-mark-dispose) + (define-key wl-summary-mode-map "mD" 'wl-summary-target-mark-delete) + (define-key wl-summary-mode-map "m~" 'wl-summary-target-mark-resend) + + (define-key wl-summary-mode-map "mu" 'wl-summary-delete-all-temp-marks) + (define-key wl-summary-mode-map "my" 'wl-summary-target-mark-save) + (define-key wl-summary-mode-map "mR" 'wl-summary-target-mark-mark-as-read) (define-key wl-summary-mode-map "m!" 'wl-summary-target-mark-mark-as-unread) (define-key wl-summary-mode-map "m$" 'wl-summary-target-mark-mark-as-important) - (define-key wl-summary-mode-map "mu" 'wl-summary-delete-all-temp-marks) (define-key wl-summary-mode-map "mU" 'wl-summary-target-mark-uudecode) (define-key wl-summary-mode-map "ma" 'wl-summary-target-mark-all) (define-key wl-summary-mode-map "mt" 'wl-summary-target-mark-thread) @@ -511,7 +509,6 @@ 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) ;; region commands (define-key wl-summary-mode-map "r" (make-sparse-keymap)) @@ -522,7 +519,9 @@ 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-dispose-region) + (define-key wl-summary-mode-map "rD" 'wl-summary-delete-region) + (define-key wl-summary-mode-map "r~" 'wl-summary-resend-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) @@ -573,15 +572,12 @@ See also variable `wl-use-petname'." (wl-summary-redisplay))) (defun wl-summary-count-unread () - (let ((pair - (elmo-msgdb-count-marks (wl-summary-buffer-msgdb) - wl-summary-new-mark - (list wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark)))) + (let ((lst (elmo-folder-count-flags wl-summary-buffer-elmo-folder))) (if (eq major-mode 'wl-summary-mode) - (setq wl-summary-buffer-new-count (car pair) - wl-summary-buffer-unread-count (cdr pair))) - pair)) + (setq wl-summary-buffer-new-count (car lst) + wl-summary-buffer-unread-count (nth 1 lst) + wl-summary-buffer-answered-count (nth 2 lst))) + lst)) (defun wl-summary-message-string (&optional use-cache) "Return full body string of current message. @@ -723,7 +719,7 @@ you." wl-summary-buffer-line-formatter formatter) (insert (wl-summary-create-line - (elmo-msgdb-make-entity + (elmo-msgdb-make-message-entity :number 10000 :from "foo" :subject "bar" @@ -839,74 +835,67 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." ;; of system internal to accord facilities for the Emacs variants. (run-hooks 'wl-summary-mode-hook)) +;;; (defun wl-summary-overview-entity-compare-by-date (x y) "Compare entity X and Y by date." (condition-case nil (string< (timezone-make-date-sortable - (elmo-msgdb-overview-entity-get-date x)) + (elmo-message-entity-field x 'date)) (timezone-make-date-sortable - (elmo-msgdb-overview-entity-get-date y))) + (elmo-message-entity-field y 'date))) (error))) ;; ignore error. (defun wl-summary-overview-entity-compare-by-number (x y) "Compare entity X and Y by number." (< - (elmo-msgdb-overview-entity-get-number x) - (elmo-msgdb-overview-entity-get-number y))) + (elmo-message-entity-number x) + (elmo-message-entity-number y))) (defun wl-summary-overview-entity-compare-by-from (x y) "Compare entity X and Y by from." (string< (wl-address-header-extract-address - (or (elmo-msgdb-overview-entity-get-from-no-decode x) + (or (elmo-message-entity-field x 'from) wl-summary-no-from-message)) (wl-address-header-extract-address - (or (elmo-msgdb-overview-entity-get-from-no-decode y) + (or (elmo-message-entity-field y 'from) wl-summary-no-from-message)))) (defun wl-summary-overview-entity-compare-by-subject (x y) "Compare entity X and Y by subject." - (string< (elmo-msgdb-overview-entity-get-subject-no-decode x) - (elmo-msgdb-overview-entity-get-subject-no-decode y))) + (string< (elmo-message-entity-field x 'subject) + (elmo-message-entity-field y 'subject))) (defun wl-summary-get-list-info (entity) "Returns (\"ML-name\" . ML-count) of ENTITY." (let (sequence ml-name ml-count subject return-path delivered-to mailing-list) - (setq sequence (elmo-msgdb-overview-entity-get-extra-field - entity "x-sequence") - ml-name (or (elmo-msgdb-overview-entity-get-extra-field - entity "x-ml-name") + (setq sequence (elmo-message-entity-field entity 'x-sequence) + ml-name (or (elmo-message-entity-field entity 'x-ml-name) (and sequence (car (split-string sequence " ")))) - ml-count (or (elmo-msgdb-overview-entity-get-extra-field - entity "x-mail-count") - (elmo-msgdb-overview-entity-get-extra-field - entity "x-ml-count") + ml-count (or (elmo-message-entity-field entity 'x-mail-count) + (elmo-message-entity-field entity 'x-ml-count) (and sequence (cadr (split-string sequence " "))))) - (and (setq subject (elmo-msgdb-overview-entity-get-subject - entity)) + (and (setq subject (elmo-message-entity-field entity 'subject t)) (setq subject (elmo-delete-char ?\n subject)) (string-match "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*" subject) (progn (or ml-name (setq ml-name (match-string 1 subject))) (or ml-count (setq ml-count (match-string 2 subject))))) (and (setq return-path - (elmo-msgdb-overview-entity-get-extra-field - entity "return-path")) + (elmo-message-entity-field entity 'return-path)) (string-match "^<\\([^@>]+\\)-return-\\([0-9]+\\)-" return-path) (progn (or ml-name (setq ml-name (match-string 1 return-path))) (or ml-count (setq ml-count (match-string 2 return-path))))) (and (setq delivered-to - (elmo-msgdb-overview-entity-get-extra-field - entity "delivered-to")) + (elmo-message-entity-field entity 'delivered-to)) (string-match "^mailing list \\([^@]+\\)@" delivered-to) (or ml-name (setq ml-name (match-string 1 delivered-to)))) (and (setq mailing-list - (elmo-msgdb-overview-entity-get-extra-field - entity "mailing-list")) + (elmo-message-entity-field entity 'mailing-list)) (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@" mailing-list) ; *-help@, *-owner@, etc. (or ml-name (setq ml-name (match-string 2 mailing-list)))) (cons (and ml-name (car (split-string ml-name " "))) @@ -943,47 +932,45 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (defun wl-summary-rescan (&optional sort-by) "Rescan current folder without updating." (interactive) - (let* ((cur-buf (current-buffer)) - (msgdb (wl-summary-buffer-msgdb)) - (overview (elmo-msgdb-get-overview msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (elmo-mime-charset wl-summary-buffer-mime-charset) - i percent num - gc-message entity - curp - (inhibit-read-only t) - (buffer-read-only nil) - expunged) - (fset 'wl-summary-append-message-func-internal - (wl-summary-get-append-message-func)) + (let ((elmo-mime-charset wl-summary-buffer-mime-charset) + i percent num + gc-message entity + curp + (inhibit-read-only t) + (buffer-read-only nil) + (numbers (elmo-folder-list-messages wl-summary-buffer-elmo-folder + nil t)) ; in-msgdb + expunged) (erase-buffer) (message "Re-scanning...") (setq i 0) - (setq num (length overview)) (when sort-by (message "Sorting by %s..." sort-by) - (setq overview - (sort overview - (intern (format "wl-summary-overview-entity-compare-by-%s" - sort-by)))) - (message "Sorting by %s...done" sort-by) - (elmo-msgdb-set-overview (wl-summary-buffer-msgdb) - overview)) - (setq curp overview) - (set-buffer cur-buf) - (setq wl-thread-entity-hashtb (elmo-make-hash (* (length overview) 2))) - (setq wl-thread-entity-list nil) - (setq wl-thread-entities nil) - (setq wl-summary-buffer-number-list nil) - (setq wl-summary-buffer-target-mark-list nil) - (setq wl-summary-buffer-refile-list nil) - (setq wl-summary-buffer-delete-list nil) - (setq wl-summary-delayed-update nil) + (setq numbers + (sort numbers + (lambda (x y) + (funcall + (intern (format "wl-summary-overview-entity-compare-by-%s" + sort-by)) + (elmo-message-entity wl-summary-buffer-elmo-folder x) + (elmo-message-entity wl-summary-buffer-elmo-folder y))))) + (message "Sorting by %s...done" sort-by)) + (setq num (length numbers)) + (setq wl-thread-entity-hashtb (elmo-make-hash (* num 2)) + wl-thread-entity-list nil + wl-thread-entities nil + wl-summary-buffer-number-list nil + wl-summary-buffer-target-mark-list nil + wl-summary-buffer-temp-mark-list nil + wl-summary-delayed-update nil) (elmo-kill-buffer wl-summary-search-buf-name) - (while curp - (setq entity (car curp)) - (wl-summary-append-message-func-internal entity msgdb nil) - (setq curp (cdr curp)) + (while numbers + (setq entity (elmo-message-entity wl-summary-buffer-elmo-folder + (car numbers))) + (wl-summary-insert-message entity + wl-summary-buffer-elmo-folder + nil) + (setq numbers (cdr numbers)) (when (> num elmo-display-progress-threshold) (setq i (+ i 1)) (if (or (zerop (% i 5)) (= i num)) @@ -996,21 +983,20 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (caar wl-summary-delayed-update) (elmo-msgdb-overview-entity-get-number (cdar wl-summary-delayed-update))) - (wl-summary-append-message-func-internal - (cdar wl-summary-delayed-update) msgdb nil t) + (wl-summary-insert-message + (cdar wl-summary-delayed-update) + wl-summary-buffer-elmo-folder nil t) (setq wl-summary-delayed-update (cdr wl-summary-delayed-update)))) (message "Constructing summary structure...done") - (set-buffer cur-buf) (if (eq wl-summary-buffer-view 'thread) (progn (message "Inserting thread...") (wl-thread-insert-top) - (message "Inserting thread...done")) - (wl-summary-make-number-list)) + (message "Inserting thread...done"))) (when wl-use-scoring (setq wl-summary-scored nil) - (wl-summary-score-headers nil msgdb - (wl-summary-rescore-msgs number-alist) + (wl-summary-score-headers (wl-summary-rescore-msgs + wl-summary-buffer-number-list) t) (when (and wl-summary-scored (setq expunged (wl-summary-score-update-all-lines))) @@ -1066,42 +1052,32 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (defun wl-summary-set-message-modified () (elmo-folder-set-message-modified-internal wl-summary-buffer-elmo-folder t) - (setq wl-summary-buffer-message-modified t)) + (setq wl-summary-buffer-message-modified t) + (wl-summary-set-mark-modified)) (defun wl-summary-message-modified-p () wl-summary-buffer-message-modified) (defun wl-summary-set-mark-modified () (elmo-folder-set-mark-modified-internal - wl-summary-buffer-elmo-folder t) - (setq wl-summary-buffer-mark-modified t)) + wl-summary-buffer-elmo-folder t)) (defun wl-summary-mark-modified-p () - wl-summary-buffer-mark-modified) + (elmo-folder-mark-modified-internal + wl-summary-buffer-elmo-folder)) (defun wl-summary-set-thread-modified () (setq wl-summary-buffer-thread-modified t)) (defun wl-summary-thread-modified-p () wl-summary-buffer-thread-modified) (defsubst wl-summary-cleanup-temp-marks (&optional sticky) - (if (or wl-summary-buffer-refile-list - wl-summary-buffer-copy-list - wl-summary-buffer-delete-list) - (if (y-or-n-p (format "Execute remaining marks in %s? " - (wl-summary-buffer-folder-name))) - (progn - (wl-summary-exec) - (if (or wl-summary-buffer-refile-list - wl-summary-buffer-copy-list - wl-summary-buffer-delete-list) - (error "Some execution was failed"))) - ;; delete temp-marks - (message "") - (wl-summary-delete-all-refile-marks) - (wl-summary-delete-all-copy-marks) - (wl-summary-delete-all-delete-marks))) - (if wl-summary-buffer-target-mark-list - (progn - (wl-summary-delete-all-target-marks) - (setq wl-summary-buffer-target-mark-list nil))) - (wl-summary-delete-all-temp-marks-on-buffer sticky) + (when wl-summary-buffer-temp-mark-list + (if (y-or-n-p (format "Execute remaining marks in %s? " + (wl-summary-buffer-folder-name))) + (progn + (wl-summary-exec) + (if wl-summary-buffer-temp-mark-list + (error "Some execution was failed"))) + ;; temp-mark-list is remained. + (message ""))) + (wl-summary-delete-all-temp-marks 'no-msg) (setq wl-summary-scored nil)) ;; a subroutine for wl-summary-exit/wl-save-status @@ -1212,17 +1188,15 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (wl-summary-cleanup-temp-marks) (erase-buffer) (wl-summary-set-message-modified) - (wl-summary-set-mark-modified) (setq wl-thread-entity-hashtb (elmo-make-hash - (* (length (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb))) 2))) + (* (elmo-folder-length + wl-summary-buffer-elmo-folder) + 2))) (setq wl-thread-entity-list nil) (setq wl-thread-entities nil) (setq wl-summary-buffer-number-list nil) (setq wl-summary-buffer-target-mark-list nil) - (setq wl-summary-buffer-refile-list nil) - (setq wl-summary-buffer-copy-list nil) - (setq wl-summary-buffer-delete-list nil)) + (setq wl-summary-buffer-temp-mark-list nil)) (defun wl-summary-sync (&optional unset-cursor force-range) (interactive) @@ -1380,25 +1354,23 @@ If ARG is non-nil, checking is omitted." (unless arg (save-excursion (wl-summary-sync-force-update))) - (wl-summary-prefetch-region (point-min) (point-max) - wl-summary-incorporate-marks)) + (wl-summary-prefetch-region-no-mark (point-min) (point-max) + wl-summary-incorporate-marks)) (defun wl-summary-prefetch-msg (number &optional arg) "Returns status-mark. if skipped, returns nil." ;; prefetching procedure. (save-excursion - (let* ((msgdb (wl-summary-buffer-msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (message-id (cdr (assq number number-alist))) - (ov (elmo-msgdb-overview-get-entity message-id msgdb)) - (wl-message-entity ov) - (entity ov) ; backward compatibility. - (size (elmo-msgdb-overview-entity-get-size ov)) + (let* ((size (elmo-message-field wl-summary-buffer-elmo-folder + number 'size)) (inhibit-read-only t) (buffer-read-only nil) - (file-cached (elmo-file-cache-exists-p message-id)) + (file-cached (elmo-file-cache-exists-p + (elmo-message-field wl-summary-buffer-elmo-folder + number 'message-id))) (force-read (and size - (or (and (null wl-prefetch-confirm) arg) + (or file-cached + (and (null wl-prefetch-confirm) arg) (null wl-prefetch-threshold) (< size wl-prefetch-threshold)))) mark new-mark) @@ -1422,11 +1394,14 @@ If ARG is non-nil, checking is omitted." (elmo-delete-char ?\" (or - (elmo-msgdb-overview-entity-get-from ov) + (elmo-message-field + wl-summary-buffer-elmo-folder + number 'from) "??")))))) " ]") size)))) (message "")) ; flush. - (setq mark (elmo-msgdb-get-mark msgdb number)) + (setq mark (or (elmo-message-mark wl-summary-buffer-elmo-folder + number) " ")) (if force-read (save-excursion (save-match-data @@ -1435,36 +1410,22 @@ If ARG is non-nil, checking is omitted." (elmo-message-encache wl-summary-buffer-elmo-folder number)) + (elmo-message-set-cached wl-summary-buffer-elmo-folder + number t) (setq new-mark - (cond - ((string= mark - wl-summary-unread-uncached-mark) - wl-summary-unread-cached-mark) - ((string= mark wl-summary-new-mark) - (setq wl-summary-buffer-new-count - (- wl-summary-buffer-new-count 1)) - (setq wl-summary-buffer-unread-count - (+ wl-summary-buffer-unread-count 1)) - wl-summary-unread-cached-mark) - ((string= mark wl-summary-read-uncached-mark) - nil) - (t mark))) - (elmo-msgdb-set-mark msgdb number new-mark) - (or new-mark (setq new-mark " ")) - (wl-summary-set-mark-modified) - (wl-summary-update-modeline) - (wl-folder-update-unread - (wl-summary-buffer-folder-name) - (+ wl-summary-buffer-unread-count - wl-summary-buffer-new-count))) + (or (elmo-message-mark wl-summary-buffer-elmo-folder + number) + " ")) + (unless (string= new-mark mark) + (wl-summary-count-unread) + (wl-summary-update-modeline) + (wl-folder-update-unread + (wl-summary-buffer-folder-name) + (+ wl-summary-buffer-unread-count + wl-summary-buffer-new-count)))) new-mark))))))) -;;(defvar wl-summary-message-uncached-marks -;; (list wl-summary-new-mark -;; wl-summary-unread-uncached-mark -;; wl-summary-read-uncached-mark)) - -(defun wl-summary-prefetch-region (beg end &optional prefetch-marks) +(defun wl-summary-prefetch-region-no-mark (beg end &optional prefetch-marks) (interactive "r") (let ((count 0) targets @@ -1506,42 +1467,30 @@ 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 wl-summary-unread-cached-mark) - (or (string= mark wl-summary-unread-cached-mark) + (string= mark elmo-msgdb-unread-cached-mark) + (or (string= mark elmo-msgdb-unread-cached-mark) (string= mark " "))) (message "Prefetching... %d/%d message(s)" (setq count (+ 1 count)) length)) ;; redisplay! - (save-excursion - (setq pos (point)) - (goto-char start-pos) - (if (pos-visible-in-window-p pos) - (save-restriction - (widen) - (sit-for 0)))) + (when mark + (save-excursion + (setq pos (point)) + (when (wl-summary-jump-to-msg (car targets)) + (wl-summary-update-mark (car targets))) + (goto-char start-pos) + (if (pos-visible-in-window-p pos) + (save-restriction + (widen) + (sit-for 0))))) (setq targets (cdr targets))) (message "Prefetched %d/%d message(s)" count length) (cons count length))))) -(defun wl-summary-prefetch (&optional arg) - "Prefetch current message." - (interactive "P") - (save-excursion - (let ((inhibit-read-only t) - (buffer-read-only nil) - (mark (wl-summary-persistent-mark))) - (setq mark (wl-summary-prefetch-msg (wl-summary-message-number) arg)) - (when mark - (delete-backward-char 1) - (insert mark) - (if wl-summary-highlight - (wl-highlight-summary-current-line))) - (set-buffer-modified-p nil) - mark))) - (defun wl-summary-delete-marks-on-buffer (marks) (while marks (wl-summary-unmark (pop marks)))) @@ -1549,34 +1498,10 @@ If ARG is non-nil, checking is omitted." (defun wl-summary-delete-copy-marks-on-buffer (copies) (wl-summary-delete-marks-on-buffer copies)) -(defun wl-summary-delete-all-refile-marks () - (let ((marks wl-summary-buffer-refile-list)) - (while marks - (wl-summary-unmark (car (pop marks)))))) - -(defun wl-summary-delete-all-copy-marks () - (let ((marks wl-summary-buffer-copy-list)) - (while marks - (wl-summary-unmark (car (pop marks)))))) - -(defun wl-summary-delete-all-delete-marks () - (wl-summary-delete-marks-on-buffer wl-summary-buffer-delete-list)) - +;;; (defun wl-summary-delete-all-target-marks () (wl-summary-delete-marks-on-buffer wl-summary-buffer-target-mark-list)) -(defun wl-summary-delete-all-temp-marks-on-buffer (&optional sticky) - ;; for summary view cache saving. - (save-excursion - (goto-char (point-min)) - (let ((inhibit-read-only t) - (buffer-read-only nil)) - (while (not (eobp)) - (unless (string= (wl-summary-temp-mark) " ") - (delete-backward-char 1) - (insert " ")) - (forward-line 1))))) - (defun wl-summary-mark-as-read-region (beg end) (interactive "r") (save-excursion @@ -1664,48 +1589,27 @@ If ARG is non-nil, checking is omitted." (y-or-n-p "Mark all messages as read? ")) (let* ((folder wl-summary-buffer-elmo-folder) (cur-buf (current-buffer)) - (msgdb (wl-summary-buffer-msgdb)) (inhibit-read-only t) (buffer-read-only nil) (case-fold-search nil) - msg mark) + msg mark new-mark) (message "Setting all msgs as read...") (elmo-folder-mark-as-read folder (elmo-folder-list-unreads - folder - (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark))) + folder)) (save-excursion (goto-char (point-min)) (while (not (eobp)) - (setq msg (wl-summary-message-number)) - (setq mark (wl-summary-persistent-mark)) - (when (and (not (string= mark " ")) - (not (string= mark wl-summary-important-mark)) - (not (string= mark wl-summary-read-uncached-mark))) + (setq msg (wl-summary-message-number) + mark (wl-summary-persistent-mark) + new-mark (or (elmo-message-mark folder msg) " ")) + (unless (string= mark new-mark) (delete-backward-char 1) - (if (or (not (elmo-message-use-cache-p folder msg)) - (string= mark wl-summary-unread-cached-mark)) - (progn - (insert " ") - (elmo-msgdb-set-mark msgdb msg nil)) - ;; New mark and unread-uncached mark - (insert wl-summary-read-uncached-mark) - (elmo-msgdb-set-mark - msgdb msg wl-summary-read-uncached-mark)) + ;; New mark and unread-uncached mark + (insert new-mark) (if wl-summary-highlight (wl-highlight-summary-current-line))) (forward-line 1))) - (elmo-folder-replace-marks - folder - (list (cons wl-summary-unread-cached-mark - nil) - (cons wl-summary-unread-uncached-mark - wl-summary-read-uncached-mark) - (cons wl-summary-new-mark - wl-summary-read-uncached-mark))) - (wl-summary-set-mark-modified) (wl-folder-update-unread (wl-summary-buffer-folder-name) 0) (setq wl-summary-buffer-unread-count 0) (setq wl-summary-buffer-new-count 0) @@ -1720,23 +1624,13 @@ If ARG is non-nil, checking is omitted." (let* ((inhibit-read-only t) (buffer-read-only nil) (folder wl-summary-buffer-elmo-folder) - (msgdb (wl-summary-buffer-msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) (case-fold-search nil) - mark number unread new-mark) - (setq mark (wl-summary-persistent-mark)) - (cond - ((or (string= mark wl-summary-new-mark) - (string= mark wl-summary-unread-uncached-mark) - (string= mark wl-summary-important-mark)) - ;; noop - ) - ((string= mark wl-summary-unread-cached-mark) - (setq new-mark wl-summary-unread-uncached-mark)) - (t - (setq new-mark wl-summary-read-uncached-mark))) - (when new-mark - (setq number (wl-summary-message-number)) + new-mark mark number unread) + (setq number (wl-summary-message-number)) + (elmo-message-set-cached folder number nil) + (setq new-mark (elmo-message-mark folder number) + mark (wl-summary-persistent-mark)) + (unless (string= new-mark mark) (delete-backward-char 1) (insert new-mark) (elmo-file-cache-delete @@ -1744,8 +1638,6 @@ If ARG is non-nil, checking is omitted." (elmo-message-field wl-summary-buffer-elmo-folder number 'message-id))) - (elmo-msgdb-set-mark msgdb number new-mark) - (wl-summary-set-mark-modified) (if wl-summary-highlight (wl-highlight-summary-current-line)) (set-buffer-modified-p nil))))) @@ -1753,44 +1645,31 @@ If ARG is non-nil, checking is omitted." (defun wl-summary-resume-cache-status () "Resume the cache status of all messages in the current folder." (interactive) - (let* ((folder wl-summary-buffer-elmo-folder) - (cur-buf (current-buffer)) - (msgdb (wl-summary-buffer-msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (inhibit-read-only t) - (buffer-read-only nil) - (case-fold-search nil) - msg mark msgid set-mark) + (let ((folder wl-summary-buffer-elmo-folder) + (buffer-read-only nil) + (case-fold-search nil) + number msgid set-mark mark) (message "Resuming cache status...") (save-excursion (goto-char (point-min)) (while (not (eobp)) - (setq msg (wl-summary-message-number)) + (setq number (wl-summary-message-number)) (setq mark (wl-summary-persistent-mark)) - (setq msgid (elmo-msgdb-get-field msgdb msg 'message-id)) + (setq msgid (elmo-message-field folder number 'message-id)) (setq set-mark nil) (if (elmo-file-cache-exists-p msgid) - (if (or - (string= mark wl-summary-unread-uncached-mark) ; U -> ! - (string= mark wl-summary-new-mark) ; N -> ! - ) - (setq set-mark wl-summary-unread-cached-mark) - (if (string= mark wl-summary-read-uncached-mark) ; u -> ' ' - (setq set-mark " "))) - (if (string= mark " ") - (setq set-mark wl-summary-read-uncached-mark) ;' ' -> u - (if (string= mark wl-summary-unread-cached-mark) - (setq set-mark wl-summary-unread-uncached-mark) ; ! -> U - ))) + (when (member mark (elmo-msgdb-uncached-marks)) + (elmo-message-set-cached folder number t) + (setq set-mark (elmo-message-mark folder number))) + (unless (member mark (elmo-msgdb-uncached-marks)) + (elmo-message-set-cached folder number nil) + (setq set-mark (or (elmo-message-mark folder number) " ")))) (when set-mark (delete-backward-char 1) (insert set-mark) - (elmo-msgdb-set-mark msgdb msg - (if (string= set-mark " ") nil set-mark)) (if wl-summary-highlight (wl-highlight-summary-current-line))) (forward-line 1)) - (wl-summary-set-mark-modified) (wl-summary-count-unread) (wl-summary-update-modeline) (message "Resuming cache status...done") @@ -1804,6 +1683,7 @@ If ARG is non-nil, checking is omitted." (msgs2 msgs) (len (length msgs)) (i 0) + ;(deleting-info (or deleting-info "Deleting...")) update-list) (elmo-kill-buffer wl-summary-search-buf-name) (while msgs @@ -1821,23 +1701,24 @@ If ARG is non-nil, checking is omitted." (delete-char 1) ; delete '\n' (setq wl-summary-buffer-number-list (delq (car msgs) wl-summary-buffer-number-list))))) - (when (and deleting-info - (> len elmo-display-progress-threshold)) - (setq i (1+ i)) - (if (or (zerop (% i 5)) (= i len)) - (elmo-display-progress - 'wl-summary-delete-messages-on-buffer deleting-info - (/ (* i 100) len)))) +; (when (> len elmo-display-progress-threshold) +; (setq i (1+ i)) +; (if (or (zerop (% i 5)) (= i len)) +; (elmo-display-progress +; 'wl-summary-delete-messages-on-buffer deleting-info +; (/ (* i 100) len)))) (setq msgs (cdr msgs))) (when (eq wl-summary-buffer-view 'thread) - (wl-thread-update-line-msgs (elmo-uniq-list update-list) - (unless deleting-info 'no-msg)) + (wl-thread-update-line-msgs (elmo-uniq-list update-list)) (wl-thread-cleanup-symbols msgs2)) + ;;(message (concat deleting-info "done")) (wl-summary-count-unread) (wl-summary-update-modeline) - (wl-folder-update-unread - (wl-summary-buffer-folder-name) - (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count))))) + (wl-folder-set-folder-updated + (elmo-folder-name-internal wl-summary-buffer-elmo-folder) + (list 0 + (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count) + (elmo-folder-length wl-summary-buffer-elmo-folder)))))) (defun wl-summary-replace-status-marks (before after) "Replace the status marks on buffer." @@ -1853,29 +1734,29 @@ If ARG is non-nil, checking is omitted." (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-get-append-message-func () +(defun wl-summary-update-status-marks () + "Synchronize status marks on current buffer to the msgdb." + (interactive) + (save-excursion + (goto-char (point-min)) + (let ((inhibit-read-only t) + (buffer-read-only nil) + mark) + (while (not (eobp)) + (unless (string= (wl-summary-persistent-mark) + (setq mark (or (elmo-message-mark + wl-summary-buffer-elmo-folder + (wl-summary-message-number)) + " "))) + (delete-backward-char 1) + (insert mark) + (if wl-summary-highlight (wl-highlight-summary-current-line))) + (forward-line 1))))) + +(defun wl-summary-insert-message (&rest args) (if (eq wl-summary-buffer-view 'thread) - 'wl-summary-insert-thread-entity - 'wl-summary-insert-sequential)) + (apply 'wl-summary-insert-thread args) + (apply 'wl-summary-insert-sequential args))) (defun wl-summary-sort () (interactive) @@ -1888,39 +1769,38 @@ If ARG is non-nil, checking is omitted." nil t nil nil (symbol-name wl-summary-default-sort-spec)))) (defun wl-summary-sync-marks () - "Update marks in summary." + "Update persistent marks in summary." (interactive) (let ((last-progress 0) + (folder wl-summary-buffer-elmo-folder) (i 0) - unread-marks importants unreads - importants-in-db unreads-in-db diff diffs + answereds importants unreads diff diffs mes progress) ;; synchronize marks. (when (not (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder) 'internal)) (message "Updating marks...") - (setq unread-marks (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark) - importants-in-db (elmo-folder-list-messages-mark-match - wl-summary-buffer-elmo-folder - (regexp-quote wl-summary-important-mark)) - unreads-in-db (elmo-folder-list-messages-mark-match - wl-summary-buffer-elmo-folder - (wl-regexp-opt unread-marks)) - importants (elmo-folder-list-importants - wl-summary-buffer-elmo-folder - wl-summary-important-mark) + (setq importants (elmo-uniq-list + (nconc + (elmo-folder-list-importants + wl-summary-buffer-elmo-folder) + (elmo-folder-list-messages-with-global-mark + wl-summary-buffer-elmo-folder + elmo-msgdb-important-mark))) unreads (elmo-folder-list-unreads - wl-summary-buffer-elmo-folder - unread-marks)) - (setq diff (elmo-list-diff importants importants-in-db)) + wl-summary-buffer-elmo-folder) + answereds (elmo-folder-list-answereds + wl-summary-buffer-elmo-folder)) + (setq diff (elmo-list-diff importants + (elmo-folder-list-flagged + wl-summary-buffer-elmo-folder + 'important 'in-msgdb))) (setq diffs (cadr diff)) ; important-deletes (setq mes (format "Updated (-%d" (length diffs))) (while diffs (wl-summary-mark-as-important (car diffs) - wl-summary-important-mark + elmo-msgdb-important-mark 'no-server) (setq diffs (cdr diffs))) (setq diffs (car diff)) ; important-appends @@ -1928,16 +1808,35 @@ If ARG is non-nil, checking is omitted." (while diffs (wl-summary-mark-as-important (car diffs) " " 'no-server) (setq diffs (cdr diffs))) - (setq diff (elmo-list-diff unreads unreads-in-db)) + + (setq diff (elmo-list-diff answereds + (elmo-folder-list-flagged + wl-summary-buffer-elmo-folder + 'answered 'in-msgdb))) + (setq diffs (cadr diff)) + (setq mes (concat mes (format "(-%d" (length diffs)))) + (while diffs + (wl-summary-mark-as-unanswered (car diffs) 'no-modeline) + (setq diffs (cdr diffs))) + (setq diffs (car diff)) ; unread-appends + (setq mes (concat mes (format "/+%d) answered mark(s)." (length diffs)))) + (while diffs + (wl-summary-mark-as-answered (car diffs) 'no-modeline) + (setq diffs (cdr diffs))) + + (setq diff (elmo-list-diff unreads + (elmo-folder-list-flagged + wl-summary-buffer-elmo-folder + 'unread 'in-msgdb))) (setq diffs (cadr diff)) (setq mes (concat mes (format "(-%d" (length diffs)))) (while diffs - (wl-summary-mark-as-read (car diffs) 'no-folder) + (wl-summary-mark-as-read (car diffs) 'no-folder 'no-modeline) (setq diffs (cdr diffs))) (setq diffs (car diff)) ; unread-appends (setq mes (concat mes (format "/+%d) unread mark(s)." (length diffs)))) (while diffs - (wl-summary-mark-as-unread (car diffs) 'no-server) + (wl-summary-mark-as-unread (car diffs) 'no-folder 'no-modeline) (setq diffs (cdr diffs))) (if (interactive-p) (message "%s" mes))))) @@ -1950,112 +1849,89 @@ If ARG is non-nil, checking is omitted." (inhibit-read-only t) (buffer-read-only nil) gc-message - overview number-alist - curp num i new-msgdb + overview + curp num i diff append-list delete-list crossed update-thread update-top-list - expunged mes sync-result entity) + expunged mes entity) (unwind-protect (progn (unless wl-summary-buffer-elmo-folder (error "(Internal error) Folder is not set:%s" (buffer-name (current-buffer)))) - (fset 'wl-summary-append-message-func-internal - (wl-summary-get-append-message-func)) ;; Flush pending append operations (disconnected operation). ;;(setq seen-list ;;(wl-summary-flush-pending-append-operations seen-list)) (goto-char (point-max)) (wl-folder-confirm-existence folder (elmo-folder-plugged-p folder)) - (setq sync-result (elmo-folder-synchronize - folder - wl-summary-new-mark - wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark - wl-summary-read-uncached-mark - wl-summary-important-mark - sync-all no-check)) - (setq new-msgdb (nth 0 sync-result)) - (setq delete-list (nth 1 sync-result)) - (setq crossed (nth 2 sync-result)) - (if sync-result + (setq crossed (elmo-folder-synchronize folder sync-all no-check)) + (if crossed (progn ;; Setup sync-all (if sync-all (wl-summary-sync-all-init)) -; (if (and has-nntp -; (elmo-nntp-max-number-precedes-list-active-p)) - ;; XXX this does not work correctly in rare case. -; (setq delete-list -; (wl-summary-delete-canceled-msgs-from-list -; delete-list -; (wl-summary-buffer-msgdb)))) + (setq diff (elmo-list-diff (elmo-folder-list-messages + folder + 'visible-only + 'in-msgdb) + wl-summary-buffer-number-list)) + (setq append-list (car diff)) + (setq delete-list (cadr diff)) + (when delete-list - (wl-summary-delete-messages-on-buffer delete-list "Deleting...") - (message "Deleting...done")) - (when new-msgdb - (wl-summary-replace-status-marks - wl-summary-new-mark - wl-summary-unread-uncached-mark)) - (setq append-list (elmo-msgdb-get-overview new-msgdb)) - (setq curp append-list) - (setq num (length curp)) - (when append-list - (setq i 0) - - ;; set these value for append-message-func - (setq overview (elmo-msgdb-get-overview - (elmo-folder-msgdb folder))) - (setq number-alist (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder))) - - (setq wl-summary-delayed-update nil) - (elmo-kill-buffer wl-summary-search-buf-name) - (while curp - (setq entity (car curp)) + (wl-summary-delete-messages-on-buffer delete-list)) + (wl-summary-update-status-marks) + (setq num (length append-list)) + (setq i 0) + (setq wl-summary-delayed-update nil) + (elmo-kill-buffer wl-summary-search-buf-name) + (dolist (number append-list) + (setq entity (elmo-message-entity folder number)) + (when (setq update-thread + (wl-summary-insert-message + entity folder + (not sync-all))) + (wl-append update-top-list update-thread)) + (if elmo-use-database + (elmo-database-msgid-put + (car entity) (elmo-folder-name-internal folder) + (elmo-msgdb-overview-entity-get-number entity))) + (when (> num elmo-display-progress-threshold) + (setq i (+ i 1)) + (if (or (zerop (% i 5)) (= i num)) + (elmo-display-progress + 'wl-summary-sync-update + (if (eq wl-summary-buffer-view 'thread) + "Making thread..." + "Inserting message...") + (/ (* i 100) num))))) + (when wl-summary-delayed-update + (while wl-summary-delayed-update + (message "Parent (%d) of message %d is no entity" + (caar wl-summary-delayed-update) + (elmo-msgdb-overview-entity-get-number + (cdar wl-summary-delayed-update))) (when (setq update-thread - (wl-summary-append-message-func-internal - entity (elmo-folder-msgdb folder) - (not sync-all))) + (wl-summary-insert-message + (cdar wl-summary-delayed-update) + wl-summary-buffer-elmo-folder + (not sync-all) t)) (wl-append update-top-list update-thread)) - (if elmo-use-database - (elmo-database-msgid-put - (car entity) (elmo-folder-name-internal folder) - (elmo-msgdb-overview-entity-get-number entity))) - (setq curp (cdr curp)) - (when (> num elmo-display-progress-threshold) - (setq i (+ i 1)) - (if (or (zerop (% i 5)) (= i num)) - (elmo-display-progress - 'wl-summary-sync-update "Updating thread..." - (/ (* i 100) num))))) - (when wl-summary-delayed-update - (while wl-summary-delayed-update - (message "Parent (%d) of message %d is no entity" - (caar wl-summary-delayed-update) - (elmo-msgdb-overview-entity-get-number - (cdar wl-summary-delayed-update))) - (when (setq update-thread - (wl-summary-append-message-func-internal - (cdar wl-summary-delayed-update) - (elmo-folder-msgdb folder) - (not sync-all) t)) - (wl-append update-top-list update-thread)) - (setq wl-summary-delayed-update - (cdr wl-summary-delayed-update)))) - (when (and (eq wl-summary-buffer-view 'thread) - update-top-list) - (wl-thread-update-indent-string-thread - (elmo-uniq-list update-top-list))) - (message "Updating thread...done")) - (unless (eq wl-summary-buffer-view 'thread) - (wl-summary-make-number-list)) - (wl-summary-set-message-modified) - (wl-summary-set-mark-modified) + (setq wl-summary-delayed-update + (cdr wl-summary-delayed-update)))) + (when (and (eq wl-summary-buffer-view 'thread) + update-top-list) + (wl-thread-update-indent-string-thread + (elmo-uniq-list update-top-list))) + (message (if (eq wl-summary-buffer-view 'thread) + "Making thread...done" + "Inserting message...done")) + (when (or delete-list append-list) + (wl-summary-set-message-modified)) (when (and sync-all (eq wl-summary-buffer-view 'thread)) (elmo-kill-buffer wl-summary-search-buf-name) - (message "Inserting thread...") + (message "Inserting message...") (wl-thread-insert-top) - (message "Inserting thread...done")) + (message "Inserting message...done")) (if elmo-use-database (elmo-database-close)) (run-hooks 'wl-summary-sync-updated-hook) @@ -2069,14 +1945,14 @@ If ARG is non-nil, checking is omitted." (length delete-list) num)))) (setq mes "Quit updating."))) ;; synchronize marks. - (if (and wl-summary-auto-sync-marks sync-result) + (if (and crossed wl-summary-auto-sync-marks) (wl-summary-sync-marks)) ;; scoring (when wl-use-scoring (setq wl-summary-scored nil) - (wl-summary-score-headers nil (wl-summary-buffer-msgdb) - (and sync-all - (wl-summary-rescore-msgs number-alist)) + (wl-summary-score-headers (and sync-all + (wl-summary-rescore-msgs + wl-summary-buffer-number-list)) sync-all) (when (and wl-summary-scored (setq expunged (wl-summary-score-update-all-lines))) @@ -2094,9 +1970,9 @@ If ARG is non-nil, checking is omitted." (wl-folder-set-folder-updated (elmo-folder-name-internal folder) (list 0 - (let ((pair (wl-summary-count-unread))) - (+ (car pair) (cdr pair))) - (elmo-folder-messages folder))) + (let ((lst (wl-summary-count-unread))) + (+ (car lst) (nth 1 lst))) + (elmo-folder-length folder))) (wl-summary-update-modeline) ;; (unless unset-cursor @@ -2202,11 +2078,8 @@ If ARG is non-nil, checking is omitted." (message "Deleting...") (elmo-folder-delete-messages wl-summary-buffer-elmo-folder dels) - (elmo-msgdb-delete-msgs (wl-summary-buffer-msgdb) - dels) -;;; (elmo-msgdb-save (wl-summary-buffer-folder-name) nil) + (elmo-folder-detach-messages wl-summary-buffer-elmo-folder dels) (wl-summary-set-message-modified) - (wl-summary-set-mark-modified) (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) (list 0 0 0)) ;;; for thread. @@ -2308,16 +2181,13 @@ If ARG, without confirm." (folder wl-summary-buffer-elmo-folder) (copy-variables (append '(wl-summary-buffer-view - wl-summary-buffer-refile-list - wl-summary-buffer-delete-list - wl-summary-buffer-copy-list + wl-summary-buffer-temp-mark-list wl-summary-buffer-target-mark-list wl-summary-buffer-elmo-folder wl-summary-buffer-number-column wl-summary-buffer-temp-mark-column wl-summary-buffer-persistent-mark-column wl-summary-buffer-message-modified - wl-summary-buffer-mark-modified wl-summary-buffer-thread-modified wl-summary-buffer-number-list wl-summary-buffer-msgdb @@ -2373,18 +2243,24 @@ If ARG, without confirm." (get-buffer-create wl-summary-buffer-name)))) (defun wl-summary-make-number-list () - (setq wl-summary-buffer-number-list - (mapcar - (lambda (x) (elmo-msgdb-overview-entity-get-number x)) - (elmo-msgdb-get-overview (wl-summary-buffer-msgdb))))) + (save-excursion + (goto-char (point-min)) + (setq wl-summary-buffer-number-list nil) + (while (not (eobp)) + (setq wl-summary-buffer-number-list + (cons (wl-summary-message-number) + wl-summary-buffer-number-list)) + (forward-line 1)) + (setq wl-summary-buffer-number-list + (nreverse wl-summary-buffer-number-list)))) (defun wl-summary-auto-select-msg-p (unread-msg) (and unread-msg (not (string= - (elmo-msgdb-get-mark - (wl-summary-buffer-msgdb) + (elmo-message-mark + wl-summary-buffer-elmo-folder unread-msg) - wl-summary-important-mark)))) + elmo-msgdb-important-mark)))) (defsubst wl-summary-open-folder (folder) ;; Select folder @@ -2618,16 +2494,20 @@ If ARG, without confirm." (ignore-errors (run-hooks 'wl-summary-line-inserted-hook))) -(defun wl-summary-insert-sequential (entity msgdb &rest args) +(defun wl-summary-insert-sequential (entity folder &rest args) (let ((inhibit-read-only t) buffer-read-only) (goto-char (point-max)) (wl-summary-insert-line (wl-summary-create-line entity nil nil - (elmo-msgdb-get-mark - msgdb - (elmo-msgdb-overview-entity-get-number - entity)))))) + (elmo-message-mark + folder + (elmo-message-entity-number + entity)))) + (setq wl-summary-buffer-number-list + (wl-append wl-summary-buffer-number-list + (list (elmo-message-entity-number entity)))) + nil)) (defun wl-summary-default-subject-filter (subject) (let ((case-fold-search t)) @@ -2648,14 +2528,15 @@ If ARG, without confirm." (` (elmo-get-hash-val (format "#%d" (wl-count-lines)) wl-summary-alike-hashtb))) -(defun wl-summary-insert-headers (overview func mime-decode) - (let (ov this last alike) +(defun wl-summary-insert-headers (folder func mime-decode) + (let ((numbers (elmo-folder-list-messages folder t t)) + ov this last alike) (buffer-disable-undo (current-buffer)) (make-local-variable 'wl-summary-alike-hashtb) - (setq wl-summary-alike-hashtb (elmo-make-hash (* (length overview) 2))) + (setq wl-summary-alike-hashtb (elmo-make-hash (* (length numbers) 2))) (when mime-decode (elmo-set-buffer-multibyte default-enable-multibyte-characters)) - (while (setq ov (pop overview)) + (while (setq ov (elmo-message-entity folder (pop numbers))) (setq this (funcall func ov)) (and this (setq this (std11-unfold-string this))) (if (equal last this) @@ -2675,7 +2556,7 @@ If ARG, without confirm." (eword-decode-region (point-min) (point-max)))) (run-hooks 'wl-summary-insert-headers-hook))) -(defun wl-summary-search-by-subject (entity overview) +(defun wl-summary-search-by-subject (entity folder) (let ((summary-buf (current-buffer)) (buf (get-buffer-create wl-summary-search-buf-name)) (folder-name (wl-summary-buffer-folder-name)) @@ -2687,15 +2568,16 @@ If ARG, without confirm." (setq wl-summary-search-buf-folder-name folder-name) (message "Creating subject cache...") (wl-summary-insert-headers - overview + folder (function (lambda (x) (funcall wl-summary-subject-filter-function - (elmo-msgdb-overview-entity-get-subject-no-decode x)))) + (elmo-message-entity-field x 'subject)))) t) (message "Creating subject cache...done")) (setq match (funcall wl-summary-subject-filter-function - (elmo-msgdb-overview-entity-get-subject entity))) + (elmo-message-entity-field entity 'subject + 'decode))) (if (string= match "") (setq match "\n")) (goto-char (point-max)) @@ -2711,50 +2593,45 @@ If ARG, without confirm." ;; the first element of found-entity list exists on ;; thread tree. (wl-thread-get-entity - (elmo-msgdb-overview-entity-get-number - (car founds))) + (elmo-message-entity-number (car founds))) ;; message id is not same as myself. (not (string= - (elmo-msgdb-overview-entity-get-id entity) - (elmo-msgdb-overview-entity-get-id (car founds)))) + (elmo-message-entity-field entity 'message-id) + (elmo-message-entity-field (car founds) + 'message-id))) ;; not a descendant. (not (wl-thread-descendant-p - (elmo-msgdb-overview-entity-get-number entity) - (elmo-msgdb-overview-entity-get-number - (car founds))))) + (elmo-message-entity-number entity) + (elmo-message-entity-number (car founds))))) (setq result (car founds) founds nil)) (setq founds (cdr founds)))))) result)))) -(defun wl-summary-insert-thread-entity (entity msgdb update - &optional force-insert) - (let* ((overview (elmo-msgdb-get-overview msgdb)) - this-id - parent-entity - parent-number - (case-fold-search t) - (depth 0) relatives anumber - cur number overview2 cur-entity linked retval delayed-entity - update-list entity-stack) +(defun wl-summary-insert-thread (entity folder update + &optional force-insert) + (let ((case-fold-search t) + (depth 0) + this-id parent-entity parent-number relatives anumber + cur number cur-entity linked retval delayed-entity + update-list entity-stack) (while entity - (setq this-id (elmo-msgdb-overview-entity-get-id entity) + (setq this-id (elmo-message-entity-field entity 'message-id) parent-entity - (elmo-msgdb-get-parent-entity entity msgdb) - parent-number (elmo-msgdb-overview-entity-get-number - parent-entity)) - (setq number (elmo-msgdb-overview-entity-get-number entity)) + (elmo-message-entity-parent folder entity) + parent-number (elmo-message-entity-number parent-entity)) + (setq number (elmo-message-entity-number entity)) (setq cur entity) ;; If thread loop detected, set parent as nil. (while cur (setq anumber - (elmo-msgdb-overview-entity-get-number - (setq cur (elmo-msgdb-get-parent-entity cur msgdb)))) + (elmo-message-entity-number + (setq cur (elmo-message-entity-parent folder cur)))) (if (memq anumber relatives) (setq parent-number nil cur nil)) (setq relatives (cons - (elmo-msgdb-overview-entity-get-number cur) + (elmo-message-entity-number cur) relatives))) (if (and parent-number (not (wl-thread-get-entity parent-number)) @@ -2770,21 +2647,21 @@ If ARG, without confirm." (string-match wl-summary-search-parent-by-subject-regexp (elmo-msgdb-overview-entity-get-subject entity))) - (let ((found (wl-summary-search-by-subject entity overview))) + (let ((found (wl-summary-search-by-subject entity folder))) (when (and found (not (member found wl-summary-delayed-update))) (setq parent-entity found) (setq parent-number - (elmo-msgdb-overview-entity-get-number parent-entity)) + (elmo-message-entity-number parent-entity)) (setq linked t)))) ;; If subject is change, divide thread. (if (and parent-number wl-summary-divide-thread-when-subject-changed (not (wl-summary-subject-equal - (or (elmo-msgdb-overview-entity-get-subject - entity) "") - (or (elmo-msgdb-overview-entity-get-subject - parent-entity) "")))) + (or (elmo-message-entity-field entity + 'subject t) "") + (or (elmo-message-entity-field parent-entity + 'subject t) "")))) (setq parent-number nil)) (setq retval (wl-thread-insert-message entity @@ -2828,782 +2705,11 @@ If ARG, without confirm." entity parent-entity nil - (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) number) + (elmo-message-mark wl-summary-buffer-elmo-folder number) (wl-thread-maybe-get-children-num number) (wl-thread-make-indent-string thr-entity) (wl-thread-entity-get-linked thr-entity))))))) -(defun wl-summary-mark-as-unread (&optional number-or-numbers - no-server-update) - (interactive) - (save-excursion - (let ((inhibit-read-only t) - (buffer-read-only nil) - (folder wl-summary-buffer-elmo-folder) - (msgdb (wl-summary-buffer-msgdb)) - number-list visible mark new-mark) - (setq number-list (or (and (numberp number-or-numbers) - (list number-or-numbers)) - number-or-numbers ; list of numbers - (and (wl-summary-message-number) ; interactive - (list (wl-summary-message-number))))) - (if (null number-list) - (message "No message.") - (unless no-server-update - (elmo-folder-unmark-read folder number-list)) - (dolist (number number-list) - (setq visible (wl-summary-jump-to-msg number) - mark (or (elmo-msgdb-get-mark msgdb number))) - (when (or (null mark) - (string= mark wl-summary-read-uncached-mark)) - (setq new-mark - (cond ((string= mark wl-summary-read-uncached-mark) - wl-summary-unread-uncached-mark) - ((elmo-message-use-cache-p folder number) - wl-summary-unread-mark) - (t - wl-summary-unread-uncached-mark))) - (when visible - (unless (string= (wl-summary-persistent-mark) new-mark) - (delete-backward-char 1) - (insert (or new-mark " ")))) - (unless (string= mark new-mark) - (elmo-msgdb-set-mark msgdb number new-mark) - (wl-summary-set-mark-modified)) - (setq wl-summary-buffer-unread-count - (+ 1 wl-summary-buffer-unread-count)) - (if (and visible wl-summary-highlight) - (wl-highlight-summary-current-line)))) - (wl-summary-update-modeline) - (wl-folder-update-unread - (wl-summary-buffer-folder-name) - (+ wl-summary-buffer-unread-count - wl-summary-buffer-new-count)) - (set-buffer-modified-p nil) - number-or-numbers ;return value - )))) - -(defun wl-summary-delete (&optional number) - "Mark a delete mark 'D'. -If optional argument NUMBER is specified, mark message specified by NUMBER." - (interactive) - (let* ((buffer-num (wl-summary-message-number)) - (msg-num (or number buffer-num)) - mark) - (catch 'done - (when (null msg-num) - (if (interactive-p) - (message "No message.")) - (throw 'done nil)) - (when (setq mark (wl-summary-get-mark msg-num)) - (when (wl-summary-reserve-temp-mark-p mark) - (if (interactive-p) - (error "Already marked as `%s'" mark)) - (throw 'done nil)) - (wl-summary-unmark msg-num)) - (if (or (interactive-p) - (eq number buffer-num)) - (wl-summary-mark-line "D")) - (setq wl-summary-buffer-delete-list - (cons msg-num wl-summary-buffer-delete-list)) - (if (interactive-p) - (if (eq wl-summary-move-direction-downward nil) - (wl-summary-prev) - (wl-summary-next))) - msg-num))) - -(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-check-mark (msg mark) - (let ((check-func (cond ((string= mark "o") - 'wl-summary-msg-marked-as-refiled) - ((string= mark "O") - 'wl-summary-msg-marked-as-copied) - ((string= mark "D") - 'wl-summary-msg-marked-as-deleted) - ((string= mark "*") - 'wl-summary-msg-marked-as-target)))) - (if check-func - (funcall check-func msg)))) - -(defun wl-summary-mark-collect (mark &optional begin end) - (save-excursion - (save-restriction - (let (msglist) - (narrow-to-region (or begin (point-min)) - (or end (point-max))) - (goto-char (point-min)) - ;; for thread... - (if (eq wl-summary-buffer-view 'thread) - (progn - (while (not (eobp)) - (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - result) - ;; opened...only myself is checked. - (if (wl-summary-check-mark number mark) - (wl-append msglist (list number))) - (unless (wl-thread-entity-get-opened entity) - ;; closed...children is also checked. - (if (setq result (wl-thread-get-children-msgs-with-mark - number - mark)) - (wl-append msglist result))) - (forward-line 1))) - (elmo-uniq-list msglist)) - (while (not (eobp)) - (when (string= (wl-summary-temp-mark) mark) - (setq msglist (cons (wl-summary-message-number) msglist))) - (forward-line 1)) - (nreverse msglist)))))) - -(defun wl-summary-exec () - (interactive) - (wl-summary-exec-subr (mapcar 'car wl-summary-buffer-refile-list) - (reverse wl-summary-buffer-delete-list) - (mapcar 'car wl-summary-buffer-copy-list))) - -(defun wl-summary-exec-region (beg end) - (interactive "r") - (message "Collecting marks...") - (save-excursion - (goto-char beg) - (beginning-of-line) - (setq beg (point)) - (goto-char (1- end)) - (forward-line) - (setq end (point)) - (wl-summary-exec-subr (wl-summary-mark-collect "o" beg end) - (wl-summary-mark-collect "D" beg end) - (wl-summary-mark-collect "O" beg end)))) - -(defun wl-summary-exec-subr (moves dels copies) - (if (not (or moves dels copies)) - (message "No marks") - (save-excursion - (let ((del-fld (wl-summary-get-delete-folder - (wl-summary-buffer-folder-name))) - (start (point)) - (unread-marks (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark)) - (refiles (append moves dels)) - (refile-failures 0) - (copy-failures 0) - (copy-len (length copies)) - refile-len - dst-msgs ; loop counter - result) - (message "Executing...") - (while dels - (when (not (assq (car dels) wl-summary-buffer-refile-list)) - (wl-append wl-summary-buffer-refile-list - (list (cons (car dels) del-fld))) - (setq wl-summary-buffer-delete-list - (delete (car dels) wl-summary-buffer-delete-list))) - (setq dels (cdr dels))) - ;; begin refile... - (setq refile-len (length refiles)) - (setq dst-msgs - (wl-inverse-alist refiles wl-summary-buffer-refile-list)) - (goto-char start) ; avoid moving cursor to - ; the bottom line. - (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)) - (if (eq 'null (car (car dst-msgs))) - 'null - (wl-folder-get-elmo-folder - (car (car dst-msgs)))) - (wl-summary-buffer-msgdb) - (not (null (cdr dst-msgs))) - nil ; no-delete - nil ; same-number - unread-marks - t)) - (error nil)) - (if result ; succeeded. - (progn - ;; update buffer. - (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs))) - ;; update refile-alist. - (setq wl-summary-buffer-refile-list - (wl-delete-associations (cdr (car dst-msgs)) - wl-summary-buffer-refile-list))) - (setq refile-failures - (+ refile-failures (length (cdr (car dst-msgs)))))) - (setq dst-msgs (cdr dst-msgs))) - (elmo-progress-clear 'elmo-folder-move-messages) - ;; end refile - ;; begin cOpy... - (setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list)) - (when (> copy-len elmo-display-progress-threshold) - (elmo-progress-set 'elmo-folder-move-messages - copy-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 - unread-marks - t)) - (error nil)) - (if result ; succeeded. - (progn - ;; update buffer. - (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs))) - ;; update copy-alist - (setq wl-summary-buffer-copy-list - (wl-delete-associations (cdr (car dst-msgs)) - wl-summary-buffer-copy-list))) - (setq copy-failures - (+ copy-failures (length (cdr (car dst-msgs)))))) - (setq dst-msgs (cdr dst-msgs))) - ;; Hide progress bar. - (elmo-progress-clear 'elmo-folder-move-messages) - ;; end cOpy - (wl-summary-folder-info-update) - (wl-summary-set-message-modified) - (wl-summary-set-mark-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%s" - (if (> refile-failures 0) - (format " (%d refiling failed)" refile-failures) - "") - (if (> copy-failures 0) - (format " (%d copying failed)" copy-failures) - "")))))) - -(defun wl-summary-erase (&optional number) - "Erase message actually, without moving it to trash." - (interactive) - (if (elmo-folder-writable-p wl-summary-buffer-elmo-folder) - (let* ((buffer-num (wl-summary-message-number)) - (msg-num (or number buffer-num))) - (if (null msg-num) - (message "No message.") - (let* ((msgdb (wl-summary-buffer-msgdb)) - (entity (elmo-msgdb-overview-get-entity msg-num msgdb)) - (subject (elmo-delete-char - ?\n (or (elmo-msgdb-overview-entity-get-subject - entity) - wl-summary-no-subject-message)))) - (when (yes-or-no-p - (format "Erase \"%s\" without moving it to trash? " - (truncate-string subject 30))) - (wl-summary-unmark msg-num) - (wl-summary-erase-subr (list msg-num)))))) - (message "Read-only folder."))) - -(defun wl-summary-target-mark-erase () - (interactive) - (if (elmo-folder-writable-p wl-summary-buffer-elmo-folder) - (if (null wl-summary-buffer-target-mark-list) - (message "No marked message.") - (when (yes-or-no-p - "Erase all marked messages without moving them to trash? ") - (wl-summary-erase-subr wl-summary-buffer-target-mark-list) - (setq wl-summary-buffer-target-mark-list nil))) - (message "Read-only folder."))) - -(defun wl-summary-erase-subr (msgs) - (elmo-folder-move-messages wl-summary-buffer-elmo-folder msgs 'null) - (wl-summary-delete-messages-on-buffer msgs) - ;; 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))) - -(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-get-mark (number) - "Return a temporal mark of message specified by NUMBER." - (or (and (memq number wl-summary-buffer-delete-list) "D") - (and (assq number wl-summary-buffer-copy-list) "O") - (and (assq number wl-summary-buffer-refile-list) "o") - (and (memq number wl-summary-buffer-target-mark-list) "*"))) - -(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 (&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) - (if (interactive-p) - (call-interactively 'wl-summary-copy) - (wl-summary-copy dst number))) - (t - (wl-summary-refile-subr 'refile (interactive-p) dst number))))) - -(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-refile-subr 'copy (interactive-p) dst number)) - -(defun wl-summary-refile-subr (copy-or-refile interactive &optional dst number) - (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)))) - (variable - (intern (format "wl-summary-buffer-%s-list" copy-or-refile))) - folder 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 mark (wl-summary-get-mark msg-num)) - (when (wl-summary-reserve-temp-mark-p mark) - (if interactive - (error "Already marked as `%s'" 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 - (if (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))))))) - (progn - (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 %s messages to %s" copy-or-refile folder)) - ;; learn for refile. - (if (eq copy-or-refile 'refile) - (wl-refile-learn entity folder)) - (wl-summary-unmark msg-num) - (set variable (append - (symbol-value variable) - (list (cons msg-num folder)))) - (when (or interactive - (eq number buffer-num)) - (wl-summary-mark-line (if (eq copy-or-refile 'refile) - "o" "O")) - ;; print refile destination - (wl-summary-print-destination msg-num folder)) - (if interactive - (if (eq wl-summary-move-direction-downward nil) - (wl-summary-prev) - (wl-summary-next))) - (run-hooks (intern (format "wl-summary-%s-hook" copy-or-refile))) - (setq wl-summary-buffer-prev-refile-destination folder) - msg-num))) - -(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))) - -(defun wl-summary-copy-prev-destination () - "Refile message to previously refiled destination." - (interactive) - (wl-summary-copy wl-summary-buffer-prev-copy-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) - (save-excursion - (beginning-of-line) - (let ((inhibit-read-only t) - (buffer-read-only nil) - visible - msg-num - cur-mark) - (if number - (setq visible (wl-summary-jump-to-msg number)) - (setq visible t)) - ;; Delete mark on buffer. - (when visible - (setq cur-mark (wl-summary-temp-mark)) - (unless (string= cur-mark " ") - (delete-backward-char 1) - (or number - (setq number (wl-summary-message-number))) - (insert (or (wl-summary-get-score-mark number) - " "))) - (if (or (string= cur-mark "o") - (string= cur-mark "O")) - (wl-summary-remove-destination)) - (if wl-summary-highlight - (wl-highlight-summary-current-line)) - (set-buffer-modified-p nil)) - ;; Remove from temporal mark structure. - (and number - (wl-summary-delete-mark number))))) - -(defun wl-summary-msg-marked-as-target (msg) - (if (memq msg wl-summary-buffer-target-mark-list) - t)) - -(defun wl-summary-msg-marked-as-copied (msg) - (assq msg wl-summary-buffer-copy-list)) - -(defun wl-summary-msg-marked-as-deleted (msg) - (if (memq msg wl-summary-buffer-delete-list) - t)) - -(defun wl-summary-msg-marked-as-refiled (msg) - (assq msg wl-summary-buffer-refile-list)) - -(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) - (let* ((buffer-num (wl-summary-message-number)) - (msg-num (or number buffer-num)) - mark) - (catch 'done - (when (null msg-num) - (if (interactive-p) - (message "No message.")) - (throw 'done nil)) - (when (setq mark (wl-summary-get-mark msg-num)) - (when (wl-summary-reserve-temp-mark-p mark) - (if (interactive-p) - (error "Already marked as `%s'" mark)) - (throw 'done nil)) - (wl-summary-unmark msg-num)) - (if (or (interactive-p) - (eq number buffer-num)) - (wl-summary-mark-line "*")) - (setq wl-summary-buffer-target-mark-list - (cons msg-num wl-summary-buffer-target-mark-list)) - (if (interactive-p) - (if (eq wl-summary-move-direction-downward nil) - (wl-summary-prev) - (wl-summary-next))) - msg-num))) - - -(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-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-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-delete-region (beg end) - (interactive "r") - (wl-summary-mark-region-subr 'wl-summary-delete beg end)) - -(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)) - (cond ((string= mark "*") - (setq wl-summary-buffer-target-mark-list nil)) - ((string= mark "D") - (setq wl-summary-buffer-delete-list nil)) - ((string= mark "O") - (setq wl-summary-buffer-copy-list nil)) - ((string= mark "o") - (setq wl-summary-buffer-refile-list nil)))) - -(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) @@ -3674,41 +2780,18 @@ If ARG, exit virtual folder." "Erase all temp marks from buffer." (interactive) (when (or wl-summary-buffer-target-mark-list - wl-summary-buffer-delete-list - wl-summary-buffer-refile-list - wl-summary-buffer-copy-list) + wl-summary-buffer-temp-mark-list) (save-excursion (goto-char (point-min)) (unless no-msg (message "Unmarking...")) (while (not (eobp)) - (wl-summary-unmark) + (wl-summary-unset-mark) (forward-line 1)) (unless no-msg (message "Unmarking...done")) (setq wl-summary-buffer-target-mark-list nil) - (setq wl-summary-buffer-delete-list nil) - (setq wl-summary-buffer-refile-list nil) - (setq wl-summary-buffer-copy-list nil)))) - -(defun wl-summary-delete-mark (number) - "Delete temporary mark of the message specified by NUMBER." - (cond - ((memq number wl-summary-buffer-target-mark-list) - (setq wl-summary-buffer-target-mark-list - (delq number wl-summary-buffer-target-mark-list))) - ((memq number wl-summary-buffer-delete-list) - (setq wl-summary-buffer-delete-list - (delq number wl-summary-buffer-delete-list))) - (t - (let (pair) - (cond - ((setq pair (assq number wl-summary-buffer-copy-list)) - (setq wl-summary-buffer-copy-list - (delq pair wl-summary-buffer-copy-list))) - ((setq pair (assq number wl-summary-buffer-refile-list)) - (setq wl-summary-buffer-refile-list - (delq pair wl-summary-buffer-refile-list)))))))) + (setq wl-summary-buffer-temp-mark-list nil)))) (defsubst wl-summary-temp-mark () "Move to the temp-mark column and return mark string." @@ -3728,107 +2811,7 @@ If ARG, exit virtual folder." (buffer-read-only nil)) (wl-summary-temp-mark) ; mark (delete-backward-char 1) - (insert mark) - (if wl-summary-highlight - (wl-highlight-summary-current-line)) - (set-buffer-modified-p nil)))) - -(defun wl-summary-target-mark-delete () - (interactive) - (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-delete 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-append wl-summary-buffer-delete-list (list (car mlist))) - (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-prefetch (&optional ignore-cache) - (interactive "P") - (save-excursion - (let* ((mlist (nreverse wl-summary-buffer-target-mark-list)) - (inhibit-read-only t) - (buffer-read-only nil) - (count 0) - (length (length mlist)) - (pos (point)) - skipped - new-mark) - (while mlist - (setq new-mark (wl-summary-prefetch-msg (car mlist) ignore-cache)) - (if new-mark - (progn - (message "Prefetching... %d/%d message(s)" - (setq count (+ 1 count)) length) - (when (wl-summary-jump-to-msg (car mlist)) - (wl-summary-unmark) - (when new-mark - (wl-summary-persistent-mark) ; move - (delete-backward-char 1) - (insert new-mark) - (if wl-summary-highlight - (wl-highlight-summary-current-line)) - (save-excursion - (goto-char pos) - (sit-for 0))))) - (setq skipped (cons (car mlist) skipped))) - (setq mlist (cdr mlist))) - (setq wl-summary-buffer-target-mark-list skipped) - (message "Prefetching... %d/%d message(s)" count length) - (set-buffer-modified-p nil)))) - -(defun wl-summary-target-mark-refile-subr (copy-or-refile) - (let ((variable - (intern (format "wl-summary-buffer-%s-list" copy-or-refile))) - (function - (intern (format "wl-summary-%s" copy-or-refile))) - (numlist wl-summary-buffer-number-list) - 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 - (set variable - (append (symbol-value variable) - (list (cons (car mlist) folder)))) - (setq wl-summary-buffer-target-mark-list - (delq (car mlist) wl-summary-buffer-target-mark-list)) - (setq mlist (cdr mlist))))))) + (insert mark)))) (defun wl-summary-next-buffer () "Switch to next summary buffer." @@ -3852,14 +2835,6 @@ If ARG, exit virtual folder." (or (cadr (memq (current-buffer) buffers)) (car buffers))))) -(defun wl-summary-target-mark-copy () - (interactive) - (wl-summary-target-mark-refile-subr "copy")) - -(defun wl-summary-target-mark-refile () - (interactive) - (wl-summary-target-mark-refile-subr "refile")) - (defun wl-summary-target-mark-mark-as-read () (interactive) (save-excursion @@ -3966,70 +2941,153 @@ If ARG, exit virtual folder." (interactive) (wl-summary-pick wl-summary-buffer-target-mark-list 'delete)) -(defun wl-summary-mark-as-read (&optional number-or-numbers no-folder-mark) +(defun wl-summary-update-mark (&optional number) + "Synch up persistent mark of current line with msgdb's." + (let ((number (or number (wl-summary-message-number))) + buffer-read-only cur-mark) + (setq cur-mark (elmo-message-mark wl-summary-buffer-elmo-folder number)) + (save-excursion + ;; set mark on buffer + (unless (string= (wl-summary-persistent-mark) cur-mark) + (delete-backward-char 1) + (insert (or cur-mark " "))) + (when wl-summary-highlight + (wl-highlight-summary-current-line)) + (set-buffer-modified-p nil)))) + +(defsubst wl-summary-mark-as-read-internal (inverse + number-or-numbers + no-folder-mark + no-modeline-update) + (save-excursion + (let ((inhibit-read-only t) + (buffer-read-only nil) + (folder wl-summary-buffer-elmo-folder) + (case-fold-search nil) + unread-message number + number-list mark visible new-mark) + (setq number-list (cond ((numberp number-or-numbers) + (setq unread-message + (member (elmo-message-mark + folder + number-or-numbers) + (elmo-msgdb-unread-marks))) + (list number-or-numbers)) + ((and (not (null number-or-numbers)) + (listp number-or-numbers)) + number-or-numbers) + ((setq number (wl-summary-message-number)) + ;; interactive + (setq unread-message + (member (elmo-message-mark folder number) + (elmo-msgdb-unread-marks))) + (list number)))) + (if (null number-list) + (message "No message.") + (if inverse + (elmo-folder-unmark-read folder number-list no-folder-mark) + (elmo-folder-mark-as-read folder number-list no-folder-mark)) + (dolist (number number-list) + (setq visible (wl-summary-jump-to-msg number) + new-mark (elmo-message-mark folder number)) + (unless inverse + (when unread-message + (run-hooks 'wl-summary-unread-message-hook))) + ;; set mark on buffer + (when visible + (unless (string= (wl-summary-persistent-mark) (or new-mark " ")) + (delete-backward-char 1) + (insert (or new-mark " "))) + (if (and visible wl-summary-highlight) + (wl-highlight-summary-current-line)) + (set-buffer-modified-p nil))) + (unless no-modeline-update + ;; Update unread numbers. + ;; should elmo-folder-mark-as-read return unread numbers? + (wl-summary-count-unread) + (wl-summary-update-modeline) + (wl-folder-update-unread + (wl-summary-buffer-folder-name) + (+ wl-summary-buffer-unread-count + wl-summary-buffer-new-count))))))) + +(defun wl-summary-mark-as-read (&optional number-or-numbers + no-folder-mark + no-modeline-update) + (interactive) + (wl-summary-mark-as-read-internal nil + number-or-numbers + no-folder-mark + no-modeline-update)) + +(defun wl-summary-mark-as-unread (&optional number-or-numbers + no-folder-mark + no-modeline-update) (interactive) + (wl-summary-mark-as-read-internal 'inverse + number-or-numbers + no-folder-mark + no-modeline-update)) + +(defsubst wl-summary-mark-as-answered-internal (inverse + number-or-numbers + no-modeline-update) (save-excursion (let ((inhibit-read-only t) (buffer-read-only nil) (folder wl-summary-buffer-elmo-folder) - (msgdb (wl-summary-buffer-msgdb)) - number-list visible mark stat new-mark) - (setq number-list (or (and (numberp number-or-numbers) - (list number-or-numbers)) - number-or-numbers ; list of numbers - (and (wl-summary-message-number) ; interactive - (list (wl-summary-message-number))))) + (case-fold-search nil) + number number-list mark visible new-mark) + (setq number-list (cond ((numberp number-or-numbers) + (list number-or-numbers)) + ((and (not (null number-or-numbers)) + (listp number-or-numbers)) + number-or-numbers) + ((setq number (wl-summary-message-number)) + ;; interactive + (list number)))) (if (null number-list) (message "No message.") - (unless no-folder-mark - (elmo-folder-mark-as-read folder number-list)) + (if inverse + (elmo-folder-unmark-answered folder number-list) + (elmo-folder-mark-as-answered folder number-list)) (dolist (number number-list) (setq visible (wl-summary-jump-to-msg number) - mark (elmo-msgdb-get-mark msgdb number)) - (cond - ((string= mark wl-summary-new-mark) ; N - (setq stat 'new)) - ((string= mark wl-summary-unread-uncached-mark) ; U - (setq stat 'unread)) - ((string= mark wl-summary-unread-cached-mark) ; ! - (setq stat 'unread)) - ((string= mark wl-summary-read-uncached-mark) ; u - (setq stat 'read))) - (setq new-mark - (if (and (elmo-message-use-cache-p folder number) - (not (elmo-folder-local-p folder)) - (not (elmo-file-cache-exists-p - (elmo-message-field wl-summary-buffer-elmo-folder - number 'message-id)))) - wl-summary-read-uncached-mark - nil)) - (cond ((eq stat 'unread) - (setq wl-summary-buffer-unread-count - (1- wl-summary-buffer-unread-count))) - ((eq stat 'new) - (setq wl-summary-buffer-new-count - (1- wl-summary-buffer-new-count)))) - (when stat - (when visible - (unless (string= (wl-summary-persistent-mark) new-mark) - (delete-backward-char 1) - (insert (or new-mark " ")))) - (unless (string= mark new-mark) - (elmo-msgdb-set-mark msgdb number new-mark)) - (wl-summary-set-mark-modified)) - (if (and visible wl-summary-highlight) - (wl-highlight-summary-current-line)) - (if stat - (save-current-buffer ; assumed by remaining - (run-hooks 'wl-summary-unread-message-hook)))) - (wl-summary-update-modeline) - (wl-folder-update-unread - (wl-summary-buffer-folder-name) - (+ wl-summary-buffer-unread-count - wl-summary-buffer-new-count)) - (set-buffer-modified-p nil) - number-or-numbers ;return value - )))) + new-mark (elmo-message-mark folder number)) + ;; set mark on buffer + (when visible + (unless (string= (wl-summary-persistent-mark) (or new-mark " ")) + (delete-backward-char 1) + (insert (or new-mark " "))) + (if (and visible wl-summary-highlight) + (wl-highlight-summary-current-line)) + (set-buffer-modified-p nil))) + (unless no-modeline-update + ;; Update unread numbers. + ;; should elmo-folder-mark-as-read return unread numbers? + (wl-summary-count-unread) + (wl-summary-update-modeline) + (wl-folder-update-unread + (wl-summary-buffer-folder-name) + (+ wl-summary-buffer-unread-count + wl-summary-buffer-new-count))))))) + +(defun wl-summary-mark-as-answered (&optional number-or-numbers + no-modeline-update) + (interactive) + (wl-summary-mark-as-answered-internal + (and (interactive-p) + (member (elmo-message-mark wl-summary-buffer-elmo-folder + (wl-summary-message-number)) + (elmo-msgdb-answered-marks))) + number-or-numbers + no-modeline-update)) + +(defun wl-summary-mark-as-unanswered (&optional number-or-numbers + no-modeline-update) + (wl-summary-mark-as-answered-internal 'inverse + number-or-numbers + no-modeline-update)) (defun wl-summary-mark-as-important (&optional number mark @@ -4043,13 +3101,12 @@ If ARG, exit virtual folder." (inhibit-read-only t) (buffer-read-only nil) (folder wl-summary-buffer-elmo-folder) - (msgdb (wl-summary-buffer-msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) message-id visible cur-mark) (if number (progn (setq visible (wl-summary-jump-to-msg number)) - (setq mark (or mark (elmo-msgdb-get-mark msgdb number)))) + (setq mark (or mark (elmo-message-mark + wl-summary-buffer-elmo-folder number)))) (setq visible t)) (when visible (if (null (setq number (wl-summary-message-number))) @@ -4061,7 +3118,8 @@ If ARG, exit virtual folder." (wl-summary-goto-previous-message-beginning))) (if (or (and (not visible) ;; already exists in msgdb. - (elmo-msgdb-overview-get-entity number msgdb)) + (elmo-message-entity wl-summary-buffer-elmo-folder + number)) (setq cur-mark (wl-summary-persistent-mark))) (progn (setq number (or number (wl-summary-message-number))) @@ -4070,12 +3128,13 @@ If ARG, exit virtual folder." wl-summary-buffer-elmo-folder number 'message-id)) - (if (string= mark wl-summary-important-mark) + (if (string= mark elmo-msgdb-important-mark) (progn ;; server side mark (save-match-data + (elmo-folder-unmark-important folder (list number) + no-server-update) (unless no-server-update - (elmo-folder-unmark-important folder (list number)) (elmo-msgdb-global-mark-delete message-id)) ;; Remove cache if local folder. (if (and (elmo-folder-local-p folder) @@ -4085,25 +3144,20 @@ If ARG, exit virtual folder." (elmo-file-cache-get-path message-id)))) (when visible (delete-backward-char 1) - (insert " ")) - (elmo-msgdb-set-mark msgdb number nil)) + (insert (or (elmo-message-mark folder number) " ")))) ;; server side mark - (save-match-data - (unless no-server-update - (elmo-folder-mark-as-important folder (list number)))) + (elmo-folder-mark-as-important folder (list number) + no-server-update) (when visible (delete-backward-char 1) - (insert wl-summary-important-mark)) - (elmo-msgdb-set-mark msgdb number - wl-summary-important-mark) + (insert elmo-msgdb-important-mark)) (if (eq (elmo-file-cache-exists-p message-id) 'entire) (elmo-folder-mark-as-read folder (list number)) ;; Force cache message. (elmo-message-encache folder number 'read)) (unless no-server-update (elmo-msgdb-global-mark-set message-id - wl-summary-important-mark))) - (wl-summary-set-mark-modified))) + elmo-msgdb-important-mark))))) (if (and visible wl-summary-highlight) (wl-highlight-summary-current-line)))) (set-buffer-modified-p nil) @@ -4123,7 +3177,7 @@ If ARG, exit virtual folder." "Return non-nil when summary line format is changed." (not (string= wl-summary-buffer-line-format - (or (elmo-object-load (expand-file-name + (or (elmo-object-load (expand-file-name wl-summary-line-format-file (elmo-folder-msgdb-path wl-summary-buffer-elmo-folder)) @@ -4272,40 +3326,24 @@ If ARG, exit virtual folder." (wl-match-string 1 wday-str) (elmo-date-get-week year month mday)))) -(defvar wl-summary-move-spec-plugged-alist - (` ((new . ((t . nil) - (p . (, wl-summary-new-mark)) - (p . (, (wl-regexp-opt - (list wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark)))) - (p . (, (regexp-quote wl-summary-important-mark))))) - (unread . ((t . nil) - (p . (, (wl-regexp-opt - (list wl-summary-new-mark - wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark)))) - (p . (, (regexp-quote wl-summary-important-mark)))))))) - -(defvar wl-summary-move-spec-unplugged-alist - (` ((new . ((t . nil) - (p . (, wl-summary-unread-cached-mark)) - (p . (, (regexp-quote wl-summary-important-mark))))) - (unread . ((t . nil) - (p . (, wl-summary-unread-cached-mark)) - (p . (, (regexp-quote wl-summary-important-mark)))))))) +(defvar wl-summary-move-spec-alist + '((new . ((t . nil) + (p . new) + (p . unread) + (p . important))) + (unread . ((t . nil) + (p . unread) + (p . important))))) (defsubst wl-summary-next-message (num direction hereto) (if wl-summary-buffer-next-message-function (funcall wl-summary-buffer-next-message-function num direction hereto) (let ((cur-spec (cdr (assq wl-summary-move-order - (if (elmo-folder-plugged-p - wl-summary-buffer-elmo-folder) - wl-summary-move-spec-plugged-alist - wl-summary-move-spec-unplugged-alist)))) + wl-summary-move-spec-alist))) (nums (memq num (if (eq direction 'up) (reverse wl-summary-buffer-number-list) wl-summary-buffer-number-list))) - marked-list nums2) + flagged-list nums2) (unless hereto (setq nums (cdr nums))) (setq nums2 nums) (if cur-spec @@ -4313,12 +3351,15 @@ If ARG, exit virtual folder." (while cur-spec (setq nums nums2) (cond ((eq (car (car cur-spec)) 'p) - (if (setq marked-list - (elmo-folder-list-messages-mark-match + (if (setq flagged-list + (elmo-folder-list-flagged wl-summary-buffer-elmo-folder (cdr (car cur-spec)))) (while nums - (if (memq (car nums) marked-list) + (if (and (memq (car nums) flagged-list) + (elmo-message-accessible-p + wl-summary-buffer-elmo-folder + (car nums))) (throw 'done (car nums))) (setq nums (cdr nums))))) ((eq (car (car cur-spec)) 't) @@ -4360,9 +3401,7 @@ If ARG, exit virtual folder." (view (expand-file-name wl-summary-view-file dir)) (save-view wl-summary-buffer-view) (mark-list (copy-sequence wl-summary-buffer-target-mark-list)) - (refile-list (copy-sequence wl-summary-buffer-refile-list)) - (copy-list (copy-sequence wl-summary-buffer-copy-list)) - (delete-list (copy-sequence wl-summary-buffer-delete-list)) + (temp-list (copy-sequence wl-summary-buffer-temp-mark-list)) (tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*")) (temp-column wl-summary-buffer-temp-mark-column) (charset wl-summary-buffer-mime-charset)) @@ -4384,11 +3423,9 @@ If ARG, exit virtual folder." (make-local-variable 'wl-summary-highlight) (setq wl-summary-highlight nil wl-summary-buffer-target-mark-list mark-list - wl-summary-buffer-refile-list refile-list - wl-summary-buffer-copy-list copy-list - wl-summary-buffer-delete-list delete-list + wl-summary-buffer-temp-mark-list temp-list wl-summary-buffer-temp-mark-column temp-column) - (wl-summary-delete-all-temp-marks) + (wl-summary-delete-all-temp-marks 'no-msg) (encode-coding-region (point-min) (point-max) (or (and wl-on-mule ; one in mcs-ltn1(apel<10.4) cannot take 2 arg. @@ -4701,13 +3738,10 @@ Return t if message exists." (interactive) (let* ((original (wl-summary-message-number)) (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: ")))) - (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))) + (entity (elmo-message-entity wl-summary-buffer-elmo-folder msgid)) msg otherfld schar - (errmsg - (format "No message with id \"%s\" in the folder." msgid))) - (if (setq msg (car (rassoc msgid number-alist))) -;;; (wl-summary-jump-to-msg-internal -;;; (wl-summary-buffer-folder-name) msg 'no-sync) + (errmsg (format "No message with id \"%s\" in the folder." msgid))) + (if (setq msg (elmo-message-entity-number entity)) (progn (wl-thread-jump-to-msg msg) t) @@ -4797,9 +3831,10 @@ Return t if message exists." folder scan-type nil nil t) (if msgid (setq msg - (car (rassoc msgid - (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb)))))) + (elmo-message-entity-number + (elmo-message-entity + wl-summary-buffer-elmo-folder + msgid)))) (setq entity (wl-folder-search-entity-by-name folder wl-folder-entity 'folder)) @@ -4897,12 +3932,14 @@ Reply to author if invoked with ARG." (when number (save-excursion (wl-summary-redisplay-internal folder number)) + (elmo-folder-mark-as-answered folder (list number)) + (wl-summary-update-mark number) (setq mes-buf wl-message-buffer) (wl-message-select-buffer wl-message-buffer) (set-buffer mes-buf) (goto-char (point-min)) (when (setq mes-buf (wl-message-get-original-buffer)) - (wl-draft-reply mes-buf arg summary-buf) + (wl-draft-reply mes-buf arg summary-buf number) (wl-draft-reply-position wl-draft-reply-default-position) (unless without-setup-hook (run-hooks 'wl-mail-setup-hook))) @@ -5011,23 +4048,23 @@ Use function list is `wl-summary-write-current-folder-functions'." () (setq skip-pmark-regexp (wl-regexp-opt (list " " - wl-summary-unread-cached-mark - wl-summary-important-mark)))) + elmo-msgdb-unread-cached-mark + elmo-msgdb-important-mark)))) (beginning-of-line) - (while (and skip - (not (if downward (eobp) (bobp)))) - (if downward - (forward-line 1) - (forward-line -1)) - (setq skip (or (string-match skip-tmark-regexp - (save-excursion - (wl-summary-temp-mark))) - (and skip-pmark-regexp - (not (string-match - skip-pmark-regexp - (save-excursion - (wl-summary-persistent-mark)))))))) - + (let (case-fold-search) + (while (and skip + (not (if downward (eobp) (bobp)))) + (if downward + (forward-line 1) + (forward-line -1)) + (setq skip (or (string-match skip-tmark-regexp + (save-excursion + (wl-summary-temp-mark))) + (and skip-pmark-regexp + (not (string-match + skip-pmark-regexp + (save-excursion + (wl-summary-persistent-mark))))))))) (if (if downward (eobp) (and (bobp) skip)) (setq goto-next t)) (if (or (eobp) (and (bobp) skip)) (goto-char start)) @@ -5169,12 +4206,11 @@ Use function list is `wl-summary-write-current-folder-functions'." (defsubst wl-summary-redisplay-internal (&optional folder number force-reload) (interactive) - (let* ((msgdb (wl-summary-buffer-msgdb)) - (folder (or folder wl-summary-buffer-elmo-folder)) + (let* ((folder (or folder wl-summary-buffer-elmo-folder)) (num (or number (wl-summary-message-number))) (wl-mime-charset wl-summary-buffer-mime-charset) (default-mime-charset wl-summary-buffer-mime-charset) - fld-buf fld-win thr-entity) + no-folder-mark fld-buf fld-win thr-entity) (if (and wl-thread-open-reading-thread (eq wl-summary-buffer-view 'thread) (not (wl-thread-entity-get-opened @@ -5193,23 +4229,29 @@ Use function list is `wl-summary-write-current-folder-functions'." (if (setq fld-win (get-buffer-window fld-buf)) (delete-window fld-win))) (setq wl-current-summary-buffer (current-buffer)) - (wl-summary-mark-as-read - num - ;; not fetched, then change server-mark. - (if (wl-message-redisplay folder num 'mime - (or force-reload - (string= (elmo-folder-name-internal - folder) - wl-draft-folder))) - nil - ;; plugged, then leave server-mark. - (if (and - (not - (elmo-folder-local-p - wl-summary-buffer-elmo-folder)) - (elmo-folder-plugged-p - wl-summary-buffer-elmo-folder)) - 'leave))) + (setq no-folder-mark + ;; If cache is used, change folder-mark. + (if (wl-message-redisplay folder num + 'mime + (or + force-reload + (string= (elmo-folder-name-internal + folder) + wl-draft-folder))) + nil + ;; plugged, then leave folder-mark. + (if (and (not (elmo-folder-local-p + wl-summary-buffer-elmo-folder)) + (elmo-folder-plugged-p + wl-summary-buffer-elmo-folder)) + 'leave))) + (when (elmo-message-use-cache-p folder num) + (elmo-message-set-cached folder num t)) + (if (member (elmo-message-mark wl-summary-buffer-elmo-folder + num) + (elmo-msgdb-unread-marks)) + (wl-summary-mark-as-read num no-folder-mark) + (wl-summary-update-mark)) (setq wl-summary-buffer-current-msg num) (when wl-summary-recenter (recenter (/ (- (window-height) 2) 2)) @@ -5500,12 +4542,9 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (let* ((buffer (generate-new-buffer " *print*")) (entity (progn (set-buffer summary-buffer) - (assoc (cdr (assq - (wl-summary-message-number) - (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb)))) - (elmo-msgdb-get-overview - (wl-summary-buffer-msgdb))))) + (elmo-message-entity + wl-summary-buffer-elmo-folder + (wl-summary-message-number)))) (wl-ps-subject (and entity (or (elmo-msgdb-overview-entity-get-subject entity) @@ -5547,14 +4586,13 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (wl-summary-unmark num)))))) (defun wl-summary-folder-info-update () - (let ((folder (elmo-string (wl-summary-buffer-folder-name))) - (num-db (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb)))) - (wl-folder-set-folder-updated folder - (list 0 - (+ wl-summary-buffer-unread-count - wl-summary-buffer-new-count) - (length num-db))))) + (wl-folder-set-folder-updated + (elmo-string (wl-summary-buffer-folder-name)) + (list 0 + (+ wl-summary-buffer-unread-count + wl-summary-buffer-new-count) + (elmo-folder-length + wl-summary-buffer-elmo-folder)))) (defun wl-summary-get-original-buffer () "Get original buffer for the current summary." diff --git a/wl/wl-thread.el b/wl/wl-thread.el index 386581e..5fe83ab 100644 --- a/wl/wl-thread.el +++ b/wl/wl-thread.el @@ -100,7 +100,7 @@ msgs-stack children) (while msgs (setq wl-summary-buffer-number-list (cons (car entity) - wl-summary-buffer-number-list)) + wl-summary-buffer-number-list)) (setq msgs (cdr msgs)) (setq children (wl-thread-entity-get-children entity)) (if children @@ -362,12 +362,8 @@ ENTITY is returned." (defun wl-thread-open-all-unread () (interactive) - (dolist (number (elmo-folder-list-messages-mark-match - wl-summary-buffer-elmo-folder - (wl-regexp-opt (list wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark - wl-summary-new-mark - wl-summary-important-mark)))) + (dolist (number (elmo-folder-list-flagged wl-summary-buffer-elmo-folder + 'digest 'in-msgdb)) (wl-thread-entity-force-open (wl-thread-get-entity number)))) (defsubst wl-thread-maybe-get-children-num (msg) @@ -378,49 +374,45 @@ ENTITY is returned." (defsubst wl-thread-update-line-on-buffer-sub (entity msg &optional parent-msg) (let* ((entity (or entity (wl-thread-get-entity msg))) (parent-msg (or parent-msg (wl-thread-entity-get-parent entity))) - (overview (elmo-msgdb-get-overview (wl-summary-buffer-msgdb))) (buffer-read-only nil) (inhibit-read-only t) - overview-entity temp-mark summary-line invisible-top dest-pair) + message-entity temp-mark summary-line invisible-top dest-pair) (if (wl-thread-delete-line-from-buffer msg) (progn (cond - ((memq msg wl-summary-buffer-delete-list) - (setq temp-mark "D")) ((memq msg wl-summary-buffer-target-mark-list) (setq temp-mark "*")) - ((setq dest-pair (assq msg wl-summary-buffer-refile-list)) - (setq temp-mark "o")) - ((setq dest-pair (assq msg wl-summary-buffer-copy-list)) - (setq temp-mark "O")) + ((setq temp-mark (wl-summary-registered-temp-mark msg)) + (setq dest-pair (cons (nth 0 temp-mark)(nth 2 temp-mark)) + temp-mark (nth 1 temp-mark))) (t (setq temp-mark (wl-summary-get-score-mark msg)))) - (when (setq overview-entity - (elmo-msgdb-overview-get-entity - msg (wl-summary-buffer-msgdb))) + (when (setq message-entity + (elmo-message-entity wl-summary-buffer-elmo-folder + msg)) (wl-summary-insert-line (wl-summary-create-line - overview-entity - (elmo-msgdb-overview-get-entity - parent-msg (wl-summary-buffer-msgdb)) + message-entity + (elmo-message-entity wl-summary-buffer-elmo-folder + parent-msg) temp-mark - (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg) + (elmo-message-mark wl-summary-buffer-elmo-folder msg) (if wl-thread-insert-force-opened nil (wl-thread-maybe-get-children-num msg)) (wl-thread-make-indent-string entity) (wl-thread-entity-get-linked entity))) (if dest-pair - (wl-summary-print-destination (car dest-pair) - (cdr dest-pair))))) + (wl-summary-print-argument (car dest-pair) + (cdr dest-pair))))) ;; insert thread (moving thread) (if (not (setq invisible-top (wl-thread-entity-parent-invisible-p entity))) (wl-summary-update-thread - (elmo-msgdb-overview-get-entity msg (wl-summary-buffer-msgdb)) + (elmo-message-entity wl-summary-buffer-elmo-folder msg) entity (and parent-msg - (elmo-msgdb-overview-get-entity - parent-msg (wl-summary-buffer-msgdb)))) + (elmo-message-entity wl-summary-buffer-elmo-folder + parent-msg))) ;; currently invisible.. update closed line. (wl-thread-update-children-number invisible-top))))) @@ -503,8 +495,7 @@ ENTITY is returned." (while msgs (setq children (wl-thread-entity-get-children (setq entity (wl-thread-get-entity (car msgs))))) - (when (elmo-msgdb-overview-get-entity (car msgs) - (wl-summary-buffer-msgdb)) + (when (elmo-message-entity wl-summary-buffer-elmo-folder (car msgs)) (wl-append ret-val (list (car msgs))) (setq children nil)) (setq msgs (cdr msgs)) @@ -522,6 +513,8 @@ ENTITY is returned." (let* ((entity (wl-thread-get-entity msg)) children older-brothers younger-brothers top-child ;;grandchildren top-entity parent update-msgs beg invisible-top) + (setq wl-summary-buffer-number-list + (delq msg wl-summary-buffer-number-list)) (when entity (setq parent (wl-thread-entity-get-parent-entity entity)) (if parent @@ -576,8 +569,6 @@ ENTITY is returned." (wl-thread-reparent-children children top-child) (wl-append update-msgs children))) ;; delete myself from top list. - (setq wl-summary-buffer-number-list - (delq msg wl-summary-buffer-number-list)) (setq older-brothers (wl-thread-entity-get-older-brothers entity nil)) (setq younger-brothers (wl-thread-entity-get-younger-brothers @@ -682,8 +673,8 @@ Message is inserted to the summary buffer." (wl-summary-update-thread overview-entity child-entity - (elmo-msgdb-overview-get-entity - parent-msg (wl-summary-buffer-msgdb))) + (elmo-message-entity wl-summary-buffer-elmo-folder + parent-msg)) (when parent ;; use thread structure. ;;(wl-thread-entity-get-nearly-older-brother @@ -742,14 +733,10 @@ Message is inserted to the summary buffer." (defun wl-thread-msg-mark-as-important (msg) "Set mark as important for invisible MSG. Modeline is not changed." - (let ((msgdb (wl-summary-buffer-msgdb)) + (let ((folder wl-summary-buffer-elmo-folder) cur-mark) - (setq cur-mark (elmo-msgdb-get-mark msgdb msg)) - (elmo-msgdb-set-mark msgdb - msg - (if (string= cur-mark wl-summary-important-mark) - nil - wl-summary-important-mark)) + (setq cur-mark (elmo-message-mark folder msg)) + (elmo-folder-mark-as-important folder (list msg)) (wl-summary-set-mark-modified))) (defun wl-thread-mark-as-read (&optional arg) @@ -764,37 +751,6 @@ Message is inserted to the summary buffer." (interactive "P") (wl-thread-call-region-func 'wl-summary-mark-as-important-region arg)) -(defun wl-thread-copy (&optional arg) - (interactive "P") - (wl-thread-call-region-func 'wl-summary-copy-region arg)) - -(defun wl-thread-refile (&optional arg) - (interactive "P") - (condition-case err - (progn - (wl-thread-call-region-func 'wl-summary-refile-region arg) - (if arg - (wl-summary-goto-top-of-current-thread)) - (wl-thread-goto-bottom-of-sub-thread)) - (error - (elmo-display-error err t) - nil))) - -(defun wl-thread-delete (&optional arg) - (interactive "P") - (wl-thread-call-region-func 'wl-summary-delete-region arg) - (if arg - (wl-summary-goto-top-of-current-thread)) - (if (not wl-summary-move-direction-downward) - (wl-summary-prev) - (wl-thread-goto-bottom-of-sub-thread) - (if wl-summary-buffer-disp-msg - (wl-summary-redisplay)))) - -(defun wl-thread-target-mark (&optional arg) - (interactive "P") - (wl-thread-call-region-func 'wl-summary-target-mark-region arg)) - (defun wl-thread-unmark (&optional arg) (interactive "P") (wl-thread-call-region-func 'wl-summary-unmark-region arg)) @@ -841,38 +797,34 @@ Message is inserted to the summary buffer." (setq cur (1+ cur)) (if (or (zerop (% cur 2)) (= cur len)) (elmo-display-progress - 'wl-thread-insert-top "Inserting thread..." + 'wl-thread-insert-top "Inserting message..." (/ (* cur 100) len))))))) (defsubst wl-thread-insert-entity-sub (indent entity parent-entity all) (let (msg-num - overview-entity + message-entity temp-mark summary-line) (when (setq msg-num (wl-thread-entity-get-number entity)) (unless all ; all...means no temp-mark. - (cond ((memq msg-num wl-summary-buffer-delete-list) - (setq temp-mark "D")) - ((memq msg-num wl-summary-buffer-target-mark-list) + (cond ((memq msg-num wl-summary-buffer-target-mark-list) (setq temp-mark "*")) - ((assq msg-num wl-summary-buffer-refile-list) - (setq temp-mark "o")) - ((assq msg-num wl-summary-buffer-copy-list) - (setq temp-mark "O")))) + ((setq temp-mark (wl-summary-registered-temp-mark msg-num)) + (setq temp-mark (nth 1 temp-mark))))) (unless temp-mark (setq temp-mark (wl-summary-get-score-mark msg-num))) - (setq overview-entity - (elmo-msgdb-overview-get-entity - (nth 0 entity) (wl-summary-buffer-msgdb))) + (setq message-entity + (elmo-message-entity wl-summary-buffer-elmo-folder + (nth 0 entity))) ;;; (wl-delete-all-overlays) - (when overview-entity + (when message-entity (wl-summary-insert-line (wl-summary-create-line - overview-entity - (elmo-msgdb-overview-get-entity - (nth 0 parent-entity) (wl-summary-buffer-msgdb)) + message-entity + (elmo-message-entity wl-summary-buffer-elmo-folder + (nth 0 parent-entity)) temp-mark - (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg-num) + (elmo-message-mark wl-summary-buffer-elmo-folder msg-num) (if wl-thread-insert-force-opened nil (wl-thread-maybe-get-children-num msg-num)) @@ -936,30 +888,29 @@ Message is inserted to the summary buffer." (forward-line 1)) (beginning-of-line))) -(defun wl-thread-remove-destination-region (beg end) +(defun wl-thread-remove-argument-region (beg end) (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (while (not (eobp)) - (let ((num (wl-summary-message-number))) - (if (assq num wl-summary-buffer-refile-list) - (wl-summary-remove-destination))) + (wl-summary-remove-argument) (forward-line 1))))) -(defun wl-thread-print-destination-region (beg end) - (if (or wl-summary-buffer-refile-list - wl-summary-buffer-copy-list) +(defun wl-thread-print-argument-region (beg end) + (if wl-summary-buffer-temp-mark-list (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (while (not (eobp)) (let ((num (wl-summary-message-number)) - pair) - (if (or (setq pair (assq num wl-summary-buffer-refile-list)) - (setq pair (assq num wl-summary-buffer-copy-list))) - (wl-summary-print-destination (car pair) (cdr pair)))) + temp-mark pair) + (when (and (setq temp-mark + (wl-summary-registered-temp-mark num)) + (nth 2 temp-mark) + (setq pair (cons (nth 0 temp-mark)(nth 2 temp-mark)))) + (wl-summary-print-argument (car pair) (cdr pair)))) (forward-line 1)))))) (defsubst wl-thread-get-children-msgs (msg &optional visible-only) @@ -983,14 +934,12 @@ Message is inserted to the summary buffer." (defun wl-thread-get-children-msgs-uncached (msg &optional uncached-marks) (let ((children-msgs (wl-thread-get-children-msgs msg)) - (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))) - mark - uncached-list) + mark uncached-list) (while children-msgs (if (and (not (eq msg (car children-msgs))) ; except itself (or (and uncached-marks - (setq mark (elmo-msgdb-get-mark - (wl-summary-buffer-msgdb) + (setq mark (elmo-message-mark + wl-summary-buffer-elmo-folder (car children-msgs))) (member mark uncached-marks)) (and (not uncached-marks) @@ -1027,8 +976,8 @@ Message is inserted to the summary buffer." (beginning-of-line) (setq beg (point)) (wl-thread-goto-bottom-of-sub-thread) - (wl-thread-remove-destination-region beg - (point)) + (wl-thread-remove-argument-region beg + (point)) (forward-char -1) ;; needed for mouse-face. (delete-region beg (point)) (wl-thread-insert-entity (- depth 1) @@ -1037,7 +986,7 @@ Message is inserted to the summary buffer." (nth 3 entity)) nil) (delete-char 1) ; delete '\n' - (wl-thread-print-destination-region beg (point)))) + (wl-thread-print-argument-region beg (point)))) (defun wl-thread-open (entity) (let (depth beg) @@ -1052,7 +1001,7 @@ Message is inserted to the summary buffer." (wl-thread-get-entity (nth 3 entity)) nil) (delete-char 1) ; delete '\n' - (wl-thread-print-destination-region beg (point)))) + (wl-thread-print-argument-region beg (point)))) (defun wl-thread-open-close (&optional force-open) (interactive "P") diff --git a/wl/wl-util.el b/wl/wl-util.el index 6f86ff3..723874d 100644 --- a/wl/wl-util.el +++ b/wl/wl-util.el @@ -902,6 +902,7 @@ is enclosed by at least one regexp grouping construct." close-paren)))) (defalias 'wl-expand-newtext 'elmo-expand-newtext) +(defalias 'wl-regexp-opt 'elmo-regexp-opt) (defun wl-region-exists-p () "Return non-nil if a region exists on current buffer." diff --git a/wl/wl-vars.el b/wl/wl-vars.el index 89dc10e..bbd4bf6 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -33,6 +33,7 @@ (require 'elmo-vars) (require 'elmo-util) +(require 'elmo-msgdb) (require 'custom) ;;; Customizable Variables @@ -331,6 +332,89 @@ If nil, never search search parent by subject." (const :tag "Don't search parent" nil)) :group 'wl-summary) +;;; Mark & Action +(defcustom wl-summary-mark-action-list + '(("*" + target-mark + nil + wl-summary-register-target-mark + nil + wl-highlight-summary-temp-face + "put target mark.") + ("d" + dispose + nil + wl-summary-register-temp-mark + wl-summary-exec-action-dispose + wl-highlight-summary-disposed-face + "dispose messages according to `wl-dispose-folder-alist'.") + ("D" + delete + nil + wl-summary-register-temp-mark + wl-summary-exec-action-delete + wl-highlight-summary-deleted-face + "delete messages immediately.") + ("o" + refile + wl-summary-get-refile-destination + wl-summary-set-action-refile + wl-summary-exec-action-refile + wl-highlight-summary-refiled-face + "refile messages to the other folder.") + ("O" + copy + wl-summary-get-copy-destination + wl-summary-register-temp-mark + wl-summary-exec-action-copy + wl-highlight-summary-copied-face + "copy messages to the other folder.") + ("i" + prefetch + nil + wl-summary-register-temp-mark + wl-summary-exec-action-prefetch + wl-highlight-summary-prefetch-face + "prefetch messages.") + ("~" + resend + wl-summary-get-resend-address + wl-summary-register-temp-mark + wl-summary-exec-action-resend + wl-highlight-summary-resend-face + )) + "A variable to define Mark & Action. +Each element of the list should be a list of +\(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 (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). +FACE is a face for highlighting." + :type '(repeat (string :tag "Temporary mark") + (symbol :tag "Set mark function") + (symbol :tag "Unset mark function") + (symbol :tag "Exec function") + (symbol :tag "Face symbol")) + :group 'wl-summary) + ;; Important folders (defcustom wl-default-folder "%inbox" "*Default folder used in `wl-summary-goto-folder'." @@ -871,34 +955,11 @@ cdr of each cons cell is used for draft message." :type 'boolean :group 'wl-folder) -(defcustom wl-summary-unread-mark "!" - "Mark for unread message." - :type '(string :tag "Mark") - :group 'wl-summary-marks) -(defcustom wl-summary-important-mark "$" - "Mark for important message." - :type '(string :tag "Mark") - :group 'wl-summary-marks) -(defcustom wl-summary-new-mark "N" - "Mark for new message." - :type '(string :tag "Mark") - :group 'wl-summary-marks) -(defcustom wl-summary-unread-uncached-mark "U" - "Mark for unread and uncached message." - :type '(string :tag "Mark") - :group 'wl-summary-marks) -(defcustom wl-summary-unread-cached-mark "!" - "Mark for unread but already cached message." - :type '(string :tag "Mark") - :group 'wl-summary-marks) -(defcustom wl-summary-read-uncached-mark "u" - "Mark for read but uncached message." - :type '(string :tag "Mark") - :group 'wl-summary-marks) (defcustom wl-summary-score-over-mark "+" "Score mark used for messages with high scores." :type '(string :tag "Mark") :group 'wl-summary-marks) + (defcustom wl-summary-score-below-mark "-" "Score mark used for messages with low scores." :type '(string :tag "Mark") @@ -954,7 +1015,7 @@ This variable is local to the summary buffers." :group 'wl-score) (defcustom wl-summary-score-marks - (list wl-summary-new-mark) + (list elmo-msgdb-new-mark) "Persistent marks to scoring." :type '(repeat (string :tag "Mark")) :group 'wl-score) @@ -1705,30 +1766,30 @@ This wrapper is generated by the mail system when rejecting a letter." :group 'wl-pref) (defcustom wl-summary-auto-refile-skip-marks - (list wl-summary-new-mark - wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark) + (list elmo-msgdb-new-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-unread-cached-mark) "Persistent marks to skip auto-refiling." :type '(repeat (string :tag "Mark")) :group 'wl-summary) (defcustom wl-summary-reserve-mark-list - (list "o" "O" "D") + (list "o" "O" "D" "d" "i") "If a message is already marked as temporal marks in this list, the message is not marked by any mark command." :type '(repeat (string :tag "Temp-Mark")) :group 'wl-summary) (defcustom wl-summary-skip-mark-list - (list "D") + (list "D" "d") "If a message is already marked as temporal marks in this list, the message is skipped at cursor move." :type '(repeat (string :tag "Temp-Mark")) :group 'wl-summary) (defcustom wl-summary-incorporate-marks - (list wl-summary-new-mark - wl-summary-unread-uncached-mark) + (list elmo-msgdb-new-mark + elmo-msgdb-unread-uncached-mark) "Persistent marks to prefetch at `wl-summary-incorporate'." :type '(repeat (string :tag "Mark")) :group 'wl-summary) @@ -2143,9 +2204,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: @@ -2320,11 +2381,10 @@ ex. :group 'wl-expire) (defcustom wl-summary-expire-reserve-marks - (list wl-summary-important-mark - wl-summary-new-mark - wl-summary-unread-mark - wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark) + (list elmo-msgdb-important-mark + elmo-msgdb-new-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-unread-cached-mark) "Permanent marks of reserved message when expire. Don't reserve temporary mark message. diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index 652184f..b0bd02c 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -90,8 +90,8 @@ wl-summary-jump-to-current-message t "Jump to Current Message"] [wl-summary-sync-force-update wl-summary-sync-force-update t "Sync Current Folder"] - [wl-summary-delete - wl-summary-delete t "Delete Current Message"] + [wl-summary-dispose + wl-summary-dispose t "Dispose Current Message"] [wl-summary-mark-as-important wl-summary-mark-as-important t "Mark Current Message as Important"] [wl-draft 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)