(defcustom elmo-folder-update-threshold 500
"Update threshold."
- :type 'integer
+ :type '(choice (integer :tag "Number of messages")
+ (const :tag "No limitation" nil))
:group 'elmo)
(defcustom elmo-folder-update-confirm t
(autoload 'elmo-dop-queue-flush "elmo-dop")
(autoload 'elmo-nntp-post "elmo-nntp")
(autoload 'elmo-global-flag-p "elmo-flag")
+ (autoload 'elmo-local-flag-p "elmo-flag")
(autoload 'elmo-global-flag-detach "elmo-flag")
(autoload 'elmo-global-flag-detach-messages "elmo-flag")
(autoload 'elmo-global-flag-set "elmo-flag")
persistent ; non-nil if persistent.
process-duplicates ; read or hide
biff ; folder for biff
+ handlers ; list of event handler.
))
(luna-define-internal-accessors 'elmo-folder))
"Rename FOLDER to NEW-NAME (string).")
(luna-define-generic elmo-folder-delete-messages (folder numbers)
- "Delete messages.
+ "Delete messages with msgdb entity.
FOLDER is the ELMO folder structure.
NUMBERS is a list of message numbers to be deleted.
It is not recommended to use this function other than internal use.
Use `elmo-folder-move-messages' with dst-folder 'null instead.")
+(luna-define-generic elmo-folder-delete-messages-internal (folder numbers)
+ "Delete messages, but no delete msgdb entity.
+FOLDER is the ELMO folder structure.
+NUMBERS is a list of message numbers to be deleted.
+Override this method by each implement of `elmo-folder'.")
+
(luna-define-generic elmo-folder-search (folder condition &optional numbers)
"Search and return list of message numbers.
FOLDER is the ELMO folder structure.
number)
"Append current buffer as a new message.
FOLDER is the destination folder (ELMO folder structure).
-FLAGS is the status of appended message (list of symbols).
-If it is nil, it is not that there is no flag and what is not defined is meant.
+FLAGS is the flag list for the appended message (list of symbols).
+If FLAGS contain `read', the message is appended as `not-unread'.
+If it is nil, the appended message will be treated as `new'.
If optional argument NUMBER is specified, the new message number is set
\(if possible\).
Return nil on failure.")
(luna-define-generic elmo-message-file-p (folder number)
"Return t if message in the FOLDER with NUMBER is a file.")
-(luna-define-generic elmo-message-flags (folder number &optional msgid)
+(luna-define-generic elmo-message-flags (folder number)
"Return a list of flags.
FOLDER is a ELMO folder structure.
+NUMBER is a number of the message.")
+
+(defun elmo-message-flags-for-append (folder number &optional message-id)
+ "Return a list of flags for `elmo-folder-append-buffer'.
+FOLDER is a ELMO folder structure.
NUMBER is a number of the message.
-If optional argument MSGID is specified,
-the message with NUMBER checks whether it has MSGID.")
+If optional argument MESSAGES-ID is not specified, get it from current buffer."
+ (let ((this-id (elmo-message-field folder number 'message-id)))
+ (and this-id
+ (string= this-id (or message-id
+ (elmo-msgdb-get-message-id-from-buffer)))
+ (or (elmo-message-flags folder number)
+ ;; message exists, but no flag.
+ '(read)))))
(luna-define-method elmo-message-flag-available-p ((folder elmo-folder) number
flag)
(elmo-msgdb-flag-available-p (elmo-folder-msgdb folder) flag))
-(luna-define-method elmo-message-flags ((folder elmo-folder) number
- &optional msgid)
- (if msgid
- (let ((this-id (elmo-message-field folder number 'message-id)))
- (and this-id
- (string= this-id msgid)
- (or (elmo-msgdb-flags (elmo-folder-msgdb folder) number)
- '(read))))
- (elmo-msgdb-flags (elmo-folder-msgdb folder) number)))
+(luna-define-method elmo-message-flags ((folder elmo-folder) number)
+ (elmo-msgdb-flags (elmo-folder-msgdb folder) number))
(defsubst elmo-message-flagged-p (folder number flag)
"Return non-nil if the message is set FLAG.
(t
(memq flag cur-flags)))))
-(luna-define-generic elmo-find-fetch-strategy
- (folder entity &optional ignore-cache)
-;; Returns the message fetching strategy suitable for the message.
-;; FOLDER is the ELMO folder structure.
-;; ENTITY is the overview entity of the message in the folder.
-;; If optional argument IGNORE-CACHE is non-nil, cache is ignored.
-;; Returned value is a elmo-fetch-strategy object.
-;; If return value is nil, message should not be nil.
- )
+(luna-define-generic elmo-find-fetch-strategy (folder number
+ &optional
+ ignore-cache
+ require-entireness)
+ "Return the message fetching strategy suitable for the message with NUMBER.
+FOLDER is the ELMO folder structure.
+If optional argument IGNORE-CACHE is non-nil, existing cache is ignored.
+If second optional argument REQUIRE-ENTIRENESS is non-nil,
+ensure that entireness of the returned strategy is entire.
+Returned value is a elmo-fetch-strategy object.
+If return value is nil, message should not be nil.")
(defmacro elmo-make-fetch-strategy (entireness
&optional
use-cache
save-cache
cache-path)
-;; Make elmo-message-fetching strategy.
-;; ENTIRENESS is 'entire or 'section.
-;; 'entire means fetch message entirely at once.
-;; 'section means fetch message section by section.
-;; If optional USE-CACHE is non-nil, existing cache is used and otherwise,
-;; existing cache is thrown away.
-;; If SAVE-CACHE is non-nil, fetched message is saved.
-;; CACHE-PATH is the cache path to be used as a message cache file.
- (` (vector (, entireness)
- (, use-cache) (, save-cache) (, cache-path))))
+ "Make elmo-message-fetching strategy.
+ENTIRENESS is 'entire or 'section.
+'entire means fetch message entirely at once.
+'section means fetch message section by section.
+If optional USE-CACHE is non-nil, existing cache is used and otherwise,
+existing cache is thrown away.
+If SAVE-CACHE is non-nil, fetched message is saved.
+CACHE-PATH is the cache path to be used as a message cache file."
+ `(vector ,entireness ,use-cache ,save-cache ,cache-path))
(defmacro elmo-fetch-strategy-entireness (strategy)
- ;; Return entireness of STRATEGY.
- (` (aref (, strategy) 0)))
+ "Return entireness of STRATEGY."
+ `(aref ,strategy 0))
(defmacro elmo-fetch-strategy-use-cache (strategy)
- ;; Return use-cache of STRATEGY.
- (` (aref (, strategy) 1)))
+ "Return use-cache of STRATEGY."
+ `(aref ,strategy 1))
(defmacro elmo-fetch-strategy-save-cache (strategy)
- ;; Return save-cache of STRATEGY.
- (` (aref (, strategy) 2)))
+ "Return save-cache of STRATEGY."
+ `(aref ,strategy 2))
(defmacro elmo-fetch-strategy-cache-path (strategy)
- ;; Return cache-path of STRATEGY.
- (` (aref (, strategy) 3)))
-
-(luna-define-method elmo-find-fetch-strategy
- ((folder elmo-folder) entity &optional ignore-cache)
- (let (cache-file size message-id number)
- (setq size (elmo-message-entity-field entity 'size))
- (setq message-id (elmo-message-entity-field entity 'message-id))
- (setq number (elmo-message-entity-number entity))
- (setq cache-file (elmo-file-cache-get message-id))
- (setq ignore-cache (or ignore-cache
- (null (elmo-message-use-cache-p folder number))))
- (if (or ignore-cache
- (null (elmo-file-cache-status cache-file)))
- ;; No cache or ignore-cache.
- (if (and (not (elmo-folder-local-p folder))
- elmo-message-fetch-threshold
- (integerp size)
- (>= size elmo-message-fetch-threshold)
- (or (not elmo-message-fetch-confirm)
- (not (prog1 (y-or-n-p
- (format "Fetch entire message(%dbytes)? "
- size))
- (message "")))))
- ;; Don't fetch message at all.
- nil
- ;; Don't use existing cache and fetch entire message at once.
- (elmo-make-fetch-strategy
- 'entire nil
- (elmo-message-use-cache-p folder number)
- (elmo-file-cache-path cache-file)))
- ;; Cache exists.
- (if (not ignore-cache)
- (elmo-make-fetch-strategy
- 'entire
- ;; ...But ignore current section cache and re-fetch
- ;; if section cache.
- (not (eq (elmo-file-cache-status cache-file) 'section))
- ;; Save cache.
- (elmo-message-use-cache-p folder number)
- (elmo-file-cache-path cache-file))))))
+ "Return cache-path of STRATEGY."
+ `(aref ,strategy 3))
+
+(luna-define-method elmo-find-fetch-strategy ((folder elmo-folder) number
+ &optional
+ ignore-cache
+ require-entireness)
+ (let ((entity (elmo-message-entity folder number)))
+ (if (null entity)
+ (elmo-make-fetch-strategy 'entire)
+ (let* ((size (elmo-message-entity-field entity 'size))
+ (message-id (elmo-message-entity-field entity 'message-id))
+ (cache-file (elmo-file-cache-get message-id))
+ (use-cache (elmo-message-use-cache-p folder number)))
+ (if (and (not ignore-cache)
+ use-cache
+ (eq (elmo-file-cache-status cache-file) 'entire))
+ ;; Cache exists and use it.
+ (elmo-make-fetch-strategy
+ 'entire
+ t ; Use cache.
+ use-cache ; Save cache.
+ (elmo-file-cache-path cache-file))
+ ;; No cache or ignore-cache.
+ (if (and (not (elmo-folder-local-p folder))
+ (not require-entireness)
+ elmo-message-fetch-threshold
+ (integerp size)
+ (>= size elmo-message-fetch-threshold)
+ (or (not elmo-message-fetch-confirm)
+ (not (prog1
+ (y-or-n-p
+ (format "Fetch entire message(%dbytes)? "
+ size))
+ (message "")))))
+ ;; Don't fetch message at all.
+ nil
+ ;; Don't use existing cache and fetch entire message at once.
+ (elmo-make-fetch-strategy
+ 'entire
+ nil ; Don't use cache.
+ use-cache ; Save cache.
+ (elmo-file-cache-path cache-file))))))))
(luna-define-method elmo-folder-list-messages-internal
((folder elmo-folder) &optional visible-only)
(luna-define-method elmo-message-encache ((folder elmo-folder) number
&optional read)
(let (path)
- (elmo-message-fetch
- folder number
- (elmo-make-fetch-strategy 'entire
- nil ;use-cache
- t ;save-cache
- (setq path (elmo-file-cache-get-path
- (elmo-message-field
- folder number 'message-id))))
- nil nil (not read))
+ (with-temp-buffer
+ (elmo-message-fetch
+ folder number
+ (elmo-make-fetch-strategy 'entire
+ nil ;use-cache
+ t ;save-cache
+ (setq path (elmo-file-cache-get-path
+ (elmo-message-field
+ folder number 'message-id))))
+ (not read)))
path))
(luna-define-generic elmo-message-fetch-bodystructure (folder number strategy)
(luna-define-generic elmo-message-fetch (folder number strategy
&optional
- section
- outbuf
- unread)
- "Fetch a message and return as a string.
+ unread
+ section)
+ "Fetch a message into current buffer.
FOLDER is the ELMO folder structure.
NUMBER is the number of the message in the FOLDER.
STRATEGY is the message fetching strategy.
-If optional argument SECTION is specified, only the SECTION of the message
-is fetched (if possible).
-If second optional argument OUTBUF is specified, fetched message is
-inserted to the buffer and returns t if fetch was ended successfully.
-If third optional argument UNREAD is non-nil, message is not flaged as read.
+If optional argument UNREAD is non-nil, message is not flaged as read.
+If second optional argument SECTION is specified, only the
+SECTION of the message is fetched (if possible).
Returns non-nil if fetching was succeed.")
(luna-define-generic elmo-message-fetch-with-cache-process (folder
(elmo-generic-folder-commit folder))
(defun elmo-generic-folder-commit (folder)
- (let ((msgdb (elmo-folder-msgdb-internal folder)))
- (when (and msgdb (elmo-folder-persistent-p folder))
- (when (elmo-msgdb-message-modified-p msgdb)
- (elmo-folder-set-info-max-by-numdb
- folder
- (elmo-folder-list-messages folder nil 'in-msgdb))
- (elmo-msgdb-killed-list-save
- (elmo-folder-msgdb-path folder)
- (elmo-folder-killed-list-internal folder)))
- (elmo-msgdb-save msgdb))))
+ (when (elmo-folder-persistent-p folder)
+ (let ((msgdb (elmo-folder-msgdb-internal folder)))
+ (when msgdb
+ (when (elmo-msgdb-message-modified-p msgdb)
+ (elmo-folder-set-info-max-by-numdb
+ folder
+ (elmo-folder-list-messages folder nil 'in-msgdb)))
+ (elmo-msgdb-save msgdb)))
+ (elmo-msgdb-killed-list-save
+ (elmo-folder-msgdb-path folder)
+ (elmo-folder-killed-list-internal folder))))
(luna-define-method elmo-folder-close-internal ((folder elmo-folder))
;; do nothing.
(elmo-folder-send folder 'elmo-folder-rename-internal new-folder)
(elmo-msgdb-rename-path folder new-folder)))
+(luna-define-method elmo-folder-delete-messages ((folder elmo-folder)
+ numbers)
+ (and (elmo-folder-delete-messages-internal folder numbers)
+ (elmo-folder-detach-messages folder numbers)))
+
(luna-define-method elmo-folder-search ((folder elmo-folder)
condition
&optional numbers)
(and cache t)
nil
cache-path)
- nil (current-buffer) t)
+ 'unread)
(set-buffer-multibyte default-enable-multibyte-characters)
(decode-coding-region (point-min) (point-max)
elmo-mime-display-as-is-coding-system)
'entire t nil
(elmo-file-cache-path cache)))
(error "Unplugged")))
- nil (current-buffer)
'unread)
(> (buffer-size) 0)
(elmo-folder-append-buffer
folder
- (elmo-message-flags
- src-folder
- (car numbers)
- (elmo-msgdb-get-message-id-from-buffer))
+ (elmo-message-flags-for-append src-folder (car numbers))
(if same-number (car numbers))))))
(error (setq failure t)))
;; FETCH & APPEND finished
(elmo-folder-close dst-folder)))
(if (and (not no-delete) succeeds)
(progn
- (if (and (elmo-folder-delete-messages src-folder succeeds)
- (elmo-folder-detach-messages src-folder succeeds))
+ (if (elmo-folder-delete-messages src-folder succeeds)
(progn
(elmo-global-flag-detach-messages
src-folder succeeds (eq dst-folder 'null))
Return non-nil when message is accessible."
(or (elmo-folder-plugged-p folder)
(elmo-folder-local-p folder)
+ (< number 0) ; in dop spool
(elmo-message-cached-p folder number)))
(luna-define-generic elmo-message-set-cached (folder number cached)
number cached)
(if cached
(elmo-msgdb-set-flag (elmo-folder-msgdb folder) number 'cached)
- (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) number 'cached)))
+ (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) number 'cached))
+ (elmo-folder-notify-event folder 'cache-changed number))
(defun elmo-message-copy-entity (entity)
(elmo-msgdb-copy-message-entity (elmo-message-entity-handler entity)
(elmo-global-flag-set flag folder number message-id)))
(elmo-msgdb-set-flag (elmo-folder-msgdb folder)
number
- flag))))
+ flag))
+ (elmo-folder-notify-event folder 'flag-changed numbers)))
(defun elmo-message-has-global-flag-p (folder number)
"Return non-nil when the message in the FOLDER with NUMBER has global flag."
(elmo-global-flag-detach flag folder number 'always))
(elmo-msgdb-unset-flag (elmo-folder-msgdb folder)
number
- flag))))
+ flag))
+ (elmo-folder-notify-event folder 'flag-changed numbers)))
(luna-define-method elmo-folder-process-crosspost ((folder elmo-folder))
;; Do nothing.
;; Let duplicates be a temporary killed message.
(elmo-folder-kill-messages folder duplicates)
;; Should be flag as read.
- (elmo-folder-set-flag folder duplicates 'read))
+ (elmo-folder-unset-flag folder duplicates 'unread))
((eq (elmo-folder-process-duplicates-internal folder)
'read)
;; Flag as read duplicates.
- (elmo-folder-set-flag folder duplicates 'read))
+ (elmo-folder-unset-flag folder duplicates 'unread))
(t
;; Do nothing.
(setq duplicates nil)))
number strategy)
nil)
+(defun elmo-message-fetch-string (folder number strategy
+ &optional
+ unread
+ section)
+ (with-temp-buffer
+ (when (elmo-message-fetch folder number strategy section unread)
+ (buffer-string))))
+
(luna-define-method elmo-message-fetch ((folder elmo-folder)
number strategy
&optional
- section
- outbuf
- unread)
- (if outbuf
- (with-current-buffer outbuf
- (erase-buffer)
- (elmo-message-fetch-with-cache-process folder number
- strategy section unread))
- (with-temp-buffer
- (elmo-message-fetch-with-cache-process folder number
- strategy section unread)
- (buffer-string))))
+ unread
+ section)
+ (erase-buffer)
+ (when (elmo-message-fetch-with-cache-process folder number
+ strategy section unread)
+ (when (and (not unread)
+ (elmo-message-flagged-p folder number 'unread))
+ (elmo-message-unset-flag folder number 'unread
+ ;; If cache does not exists, update only msgdb.
+ ;; otherwise, flag status on server should be
+ ;; changed since it is never touched at this
+ ;; point.
+ (not (elmo-message-flagged-p
+ folder number 'cached))))
+ t))
(luna-define-method elmo-message-fetch-with-cache-process ((folder elmo-folder)
number strategy
ignore-msgdb
no-check
mask)
- (let ((killed-list (elmo-folder-killed-list-internal folder))
- (before-append t)
- old-msgdb diff diff-2 delete-list new-list new-msgdb flag
- flag-table crossed after-append)
- (setq old-msgdb (elmo-folder-msgdb folder))
- (setq flag-table (elmo-flag-table-load (elmo-folder-msgdb-path folder)))
+ (let ((old-msgdb (elmo-folder-msgdb folder))
+ (killed-list (elmo-folder-killed-list-internal folder))
+ (flag-table (elmo-flag-table-load (elmo-folder-msgdb-path folder)))
+ (before-append t))
(when ignore-msgdb
(elmo-msgdb-flag-table (elmo-folder-msgdb folder) flag-table)
(elmo-folder-clear folder (not disable-killed)))
(unless no-check (elmo-folder-check folder))
(condition-case nil
- (progn
+ (let ((killed-list (elmo-folder-killed-list-internal folder))
+ diff-new diff-del
+ delete-list new-list new-msgdb crossed)
(message "Checking folder diff...")
- (setq diff (elmo-list-diff (elmo-folder-list-messages
- folder
- (not disable-killed))
- (elmo-folder-list-messages
- folder
- (not disable-killed)
- 'in-msgdb)))
- (when (and mask (car diff))
- (setcar diff (elmo-list-filter mask (car diff))))
+ (elmo-set-list
+ '(diff-new diff-del)
+ (elmo-list-diff (elmo-folder-list-messages folder)
+ (elmo-folder-list-messages folder nil 'in-msgdb)))
+ (when diff-new
+ (unless disable-killed
+ (setq diff-new (elmo-living-messages diff-new killed-list)))
+ (when mask
+ (setq diff-new (elmo-list-filter mask diff-new))))
(message "Checking folder diff...done")
- (setq new-list (elmo-folder-confirm-appends (car diff)))
- ;; 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-folder-kill-messages-range
- folder
- (car (car diff-2))
- (nth (- (length (car diff-2)) 1) (car diff-2))))
- (setq delete-list (cadr diff))
- (if (or (equal diff '(nil nil))
- (equal diff '(nil))
- (and (eq (length (car diff)) 0)
- (eq (length (cadr diff)) 0)))
+ (setq new-list (elmo-folder-confirm-appends diff-new))
+ ;; Append to killed list as (MIN-OF-DISAPPEARED . MAX-OF-DISAPPEARED)
+ (when (not (eq (length diff-new)
+ (length new-list)))
+ (let* ((diff (elmo-list-diff diff-new new-list))
+ (disappeared (car diff)))
+ (when disappeared
+ (elmo-folder-kill-messages-range folder
+ (car disappeared)
+ (elmo-last disappeared)))))
+ (setq delete-list diff-del)
+ (if (and (null diff-new) (null diff-del))
(progn
(elmo-folder-update-number folder)
(elmo-folder-process-crosspost folder)
- 0 ; no updates.
- )
+ 0) ; `0' means no updates.
(when delete-list
(elmo-folder-detach-messages folder delete-list))
(when new-list
(luna-define-method elmo-folder-detach-messages ((folder elmo-folder)
numbers)
- (elmo-msgdb-delete-messages (elmo-folder-msgdb folder) numbers))
+ (when (elmo-msgdb-delete-messages (elmo-folder-msgdb folder) numbers)
+ ;; Remove NUMBERS from killed message list.
+ (elmo-folder-set-killed-list-internal
+ folder
+ (elmo-number-set-delete-list
+ (elmo-folder-killed-list-internal folder)
+ numbers))
+ t))
(luna-define-generic elmo-folder-length (folder)
"Return number of messages in the FOLDER.")
(elmo-make-directory temp-dir)
temp-dir))
+;; Event notification/observer framework
+(eval-and-compile
+ (luna-define-class elmo-event-handler ()))
+
+(luna-define-generic elmo-event-handler-flag-changed (handler numbers)
+ "Notify flag of the messages with NUMBERS is changed.")
+
+(luna-define-generic elmo-event-handler-cache-changed (handler number)
+ "Called when cache status of the message with NUMBER is changed.")
+
+(defun elmo-folder-add-handler (folder handler)
+ (unless (memq handler (elmo-folder-handlers-internal folder))
+ (elmo-folder-set-handlers-internal
+ folder
+ (cons handler (elmo-folder-handlers-internal folder)))))
+
+(defun elmo-folder-remove-handler (folder handler)
+ (elmo-folder-set-handlers-internal
+ folder
+ (delq handler (elmo-folder-handlers-internal folder))))
+
+(defun elmo-folder-notify-event (folder event &rest args)
+ (when (elmo-folder-handlers-internal folder)
+ (let ((message (format "elmo-event-handler-%s" event)))
+ (dolist (handler (elmo-folder-handlers-internal folder))
+ (apply #'luna-send handler message handler args)))))
+
+;;;
(defun elmo-init ()
"Initialize ELMO module."
(elmo-crosspost-message-alist-load)
'elmo-cache-directory)
(elmo-define-obsolete-variable 'elmo-msgdb-dir
'elmo-msgdb-directory)
+(elmo-define-obsolete-variable 'elmo-global-flag-list
+ 'elmo-global-flags)
;; Obsolete functions.
;; 2001-12-11: *-dir -> *-directory
projects / elisp / wanderlust.git / blobdiff