+2003-07-19 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * etc/icons/wl-summary-dispose-up.xpm: New file.
+
+2003-07-15 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * WL-ELS (WL-MODULES): Added wl-action.
+
2003-06-05 TAKAHASHI Kaoru <kaoru@kaisei.org>
* WL-MK: Remove comment out code. Fix indent.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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
* elmo-version.el (elmo-version): Up to 2.11.4.
+2003-07-23 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-pipe.el (elmo-folder-unmark-answered): Define.
+ (elmo-folder-mark-as-answered): Ditto.
+
+2003-07-22 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo.el (elmo-generic-folder-append-messages): Set flag as nil
+ if mark is nil.
+
+2003-07-17 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * elmo.el (elmo-folder-synchronize): Fixed bug when sync-all.
+
2003-07-12 Yuuichi Teranishi <teranisi@gohome.org>
+ * 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.
* elmo-pipe.el (elmo-folder-clear): Implemented clear copied-list.
+2003-04-05 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <yoichi@geiin.org>
* elmo.el (elmo-folder-delete): Confirm deletion here, return t if
* elmo-localdir.el (elmo-folder-rename-internal): Referctoring;
Replace nested conditional with guard clauses.
-2003-01-30 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * elmo-archive.el (elmo-folder-rename-internal): Referctoring;
- Replace nested conditional with guard clauses.
-
2003-01-30 Yuuichi Teranishi <teranisi@gohome.org>
* pldap.el (ldap-search-basic): Don't treat exit status 32 as an
* elmo-imap4.el (elmo-folder-msgdb-create-plugged): Bind print-level,
print-depth.
+2003-01-30 TAKAHASHI Kaoru <kaoru@kaisei.org>
+
+ * elmo-archive.el (elmo-folder-rename-internal): Referctoring;
+ Replace nested conditional with guard clauses.
+
2003-01-29 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
* elmo-util.el (elmo-object-save): Bind print-level, print-length.
* elmo-imap4.el: Remove Nemacs hack, replace `elmo-read' by `read'.
* elmo-util.el: Ditto.
+2002-10-28 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo.el (elmo-message-accessible-p): Renamed from
+ elmo-message-cached-p and rewritten.
+
+2002-10-27 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
* elmo-version.el (elmo-version): Up to 2.11.0.
-2002-10-22 Yuuichi Teranishi <teranisi@gohome.org>
+2002-10-24 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-filter.el (elmo-folder-diff): Fixed condition checking
+ `last:' filter.
+
2002-10-12 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
* elmo-dop.el (elmo-folder-status-dop): If spool-folder is absent,
* elmo-dop.el (elmo-dop-queue-flush): Check obsolete at first.
(elmo-dop-queue-flush): Fixed last change.
+2002-10-01 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * elmo-msgdb.el (elmo-msgdb-set-cached): Set mark-modified slot.
+
+2002-09-24 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
* 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
* elmo-imap4.el (elmo-imap4-parse-status): Skip white spaces after
status number.
+2002-09-17 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-filter.el (elmo-folder-msgdb-create): Add to mark-alist if
+ original mark is non-nil.
+
+2002-09-17 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
* elmo-dop.el (elmo-dop-queue-flush): Remove unused argument.
(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))
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
(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
(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))
(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
;;; 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))
(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))))
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)
(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)))
(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
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
(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")))
(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))
'(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")
(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")))
(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)))
(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
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
(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
;;; 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)
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
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
;; 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)
(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
(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))
(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))
(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."
;;
;; 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
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
(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
((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))))
(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
(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)
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)
(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
(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
((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)
(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)
(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))
(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)
"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
(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))
(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))
(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...")
(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
(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))
;; 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)))
(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))
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))
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)
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)
(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)
(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
(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)
"")
((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)))
(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)
folder))
(elmo-map-folder-location-alist-internal folder))))
t) ; success
-
(require 'product)
(product-provide (provide 'elmo-map) (require 'elmo-version))
(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
(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)
(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))
(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)
(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."
(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
(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
(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
(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
(defsubst elmo-msgdb-get-mark-hashtb (msgdb)
(cdr (nth 3 msgdb)))
+(defsubst elmo-msgdb-get-path (msgdb)
+ (nth 4 msgdb))
+
;;
;; number <-> Message-ID handling
;;
(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
;;
;; 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
(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)
(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)
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)
(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
(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))
(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)))
(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)))
(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))
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
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))
(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)
(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
(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 '<))
(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
(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))
(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))
(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))
(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))
((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)
(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)
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)
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))
(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))
(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))
(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)
(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")
("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
(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))))
(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
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))
'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
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
(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)
;; 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)
(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
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)))
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))
(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))
(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
(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))
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))
(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))
(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)))
(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))
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)
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)
(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))
(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)
(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)))))))
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)
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
(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
(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
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
(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))
(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))
(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))))
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))
(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))
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)))
" 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
(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"
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 "$")
(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
(defmacro elmo-get-hash-val (string hashtable)
`(and (stringp ,string)
+ ,hashtable
(let ((sym (intern-soft ,string ,hashtable)))
(if (boundp sym)
(symbol-value sym)))))
(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))
(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."
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))
;;;###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))
(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.
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.")
(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)
;; 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.
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.
(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).")
((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."
(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).")
(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)
(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))))
(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
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))
(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
(> (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.
no-delete-info
no-delete
same-number
- unread-marks
save-unread)
(save-excursion
(let* ((messages msgs)
(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.")
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.
(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
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.
(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))
(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))
(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.
(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)
(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)
2.10.1 Watching The Wheels
2.11.x Wonderwall
+2.11.3 Wanted Dead Or Alive
* Version number is increased to 2.11.4.
+2003-07-24 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-action.el (wl-summary-set-mark): Fixed last change.
+
+2003-07-20 Yuuichi Teranishi <teranisi@ns.templewest.net>
+
+ * wl-summary.el (wl-summary-mark-as-read-internal): Fixed the
+ behavior of wl-summary-unread-message-hook
+ (Pointed out by akira yamada <akira@arika.org>).
+
+2003-07-19 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <yoichi@geiin.org>
* 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 <teranisi@gohome.org>
+
+ * wl-acap.el (toplevel): Don't require un-define.
+
+2003-07-18 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-summary.el (wl-summary-prefetch-region-no-mark): Update
+ persistent mark when prefetch is succeeded.
+
2003-07-17 Yuuichi Teranishi <teranisi@gohome.org>
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <mito@mxa.nes.nec.co.jp>
* wl-summary.el (wl-summary-entity-info-msg): Don't replace '%' to
2003-07-15 Yuuichi Teranishi <teranisi@gohome.org>
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <yoichi@geiin.org>
* wl-vars.el (wl-thread-indent-level, wl-thread-*-str): Choose
* wl-util.el (wl-as-coding-system): Define for non-mule too.
+2003-04-05 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-summary.el (wl-summary-mark-as-important): Fixed the last
+ change.
+
+2003-04-02 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <yoichi@geiin.org>
* wl-fldmgr.el (wl-fldmgr-delete): Move confirmation to elmo side,
(wl-user-agent-compose): Bind wl-draft-buffer-style with
switch-function.
+2002-11-07 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <cooper@saitama.fujimic.fujisankei-g.co.jp>
* wl-address.el (wl-address-make-completion-entry): Extracted from
* wl-message.el (wl-message-get-original-buffer): Avoid
'Selecting deleted buffer' error when original buffer is killed.
+2002-10-28 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-summary.el (wl-summary-next-message): Use
+ elmo-message-accessible-p instead of elmo-message-cached-p.
+
+2002-10-27 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+ * wl-version.el (wl-version): Changed codename.
+
* Version number is increased to 2.11.0.
+2002-10-24 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
* wl-draft.el (wl-draft-highlight-and-recenter): Restore
* wl-mime.el (wl-message-delete-current-part): Use `delete-region'
instead of `kill-region'.
+2002-10-18 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
* wl-mime.el (wl-mime-preview-follow-current-region): New function
* wl-mule.el (wl-message-define-keymap): Ditto.
* wl-xmas.el (wl-message-define-keymap): Ditto.
-2002-10-18 Yuuichi Teranishi <teranisi@gohome.org>
-
- * wl-mime.el (wl-message-delete-current-part): Check the class of
- mime-entity.
-
2002-10-16 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
* wl-mime.el (wl-message-delete-current-part): New function.
* wl-mime.el (wl-summary-burst): Get elmo folder correctly.
Take prefix argument to force asking the destination folder.
+2002-09-26 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-summary.el (wl-summary-prefetch-msg): If mark is changed,
+ count and update status.
+
+2002-09-24 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
* wl-summary.el (wl-summary-cursor-move-surface): Add missing
function, a wrapper for `mime-decrypt-application/pgp-encrypted'.
(wl-mime-setup): Add its entry.
+2002-09-17 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
* wl-mime.el (wl-draft-preview-message): Restore the position
;;; 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)
--- /dev/null
+;;; wl-action.el --- Mark and actions in the Summary mode for Wanderlust.
+
+;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; 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
(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)
((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)
(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"
"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
(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)
(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.")
(if arg
(let (buf mail-reply-buffer)
(elmo-set-work-buf
+ (insert "\n")
(yank)
(setq buf (current-buffer)))
(setq mail-reply-buffer buf)
(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 "")))
(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)))))
(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
(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))
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
(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)
(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"
(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
(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)
(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
(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)))
(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))))))
(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)
(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)))
(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'.
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
(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))
(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'.
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)
(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))))
(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
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)
(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)))
(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))))
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)
(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))))
(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)
((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
(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))))
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))
""
(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
"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)
(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))
(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
(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))
(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))))))
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)))
(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
: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))
(((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)
: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
'(
"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)
(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))
(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)
(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)))))
(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 ()
'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
(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)
(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)
(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)
(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)) ""))
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)
(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)
(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))
(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)
(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
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
(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 "")))
(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)
;;
(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)
(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))
(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
(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
(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))
(< 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))
(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*")
(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))
"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))
;; 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."
(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)
((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))
'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)))
(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)
(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)
(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)
(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))))
(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:"
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)
["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]
["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]
(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)
(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))
(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)
;; 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)
(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))
(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)
(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.
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"
;; 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 " ")))
(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))
(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)))
(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
(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)
(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)
(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
(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
(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))))
(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
(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)
(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
(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)))))
(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")
(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
(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."
(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)
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
(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)))))
(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)
(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)))
(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
(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.
(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
(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
(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))
(` (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)
(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))
(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))
;; 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))
(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
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)
"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."
(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."
(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
(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
(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)))
(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)))
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)
(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)
"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))
(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
(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)
(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))
(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.
(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)
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))
(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)))
()
(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))
(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
(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))
(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)
(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."
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
(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)
(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)))))
(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))
(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
(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
(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
(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)
(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))
(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))
(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)
(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)
(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)
(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)
(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")
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."
(require 'elmo-vars)
(require 'elmo-util)
+(require 'elmo-msgdb)
(require 'custom)
;;; Customizable Variables
(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'."
: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")
: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)
: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)
: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:
: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.
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
(provide 'wl) ; circular dependency
(require 'wl-folder)
(require 'wl-summary)
+(require 'wl-action)
(require 'wl-thread)
(require 'wl-address)
(require 'wl-news)
(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)
projects / elisp / wanderlust.git / commitdiff