(require 'elmo-vars)
(require 'elmo-util)
(require 'elmo-msgdb)
+(require 'elmo-signal)
(eval-when-compile (require 'cl))
(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
:type 'boolean
:group 'elmo)
+(defcustom elmo-msgdb-path-encode-threshold nil
+ "*Encode msgdb path if its length is longer than this value."
+ :type '(choice (const :tag "No encode" nil)
+ number)
+ :group 'elmo)
+
(defvar elmo-message-displaying nil
"A global switch to indicate message is displaying or not.")
(elmo-define-error 'elmo-authenticate-error "Login failed" 'elmo-open-error)
(elmo-define-error 'elmo-imap4-bye-error "IMAP4 session was terminated" 'elmo-open-error)
+;; Event declarations
+(elmo-define-signal flag-changing (number old-flags new-flags)
+ "Notify the changing flag of the messages with NUMBER.")
+
+(elmo-define-signal flag-changed (numbers)
+ "Notify the change flag of the messages with NUMBERS.")
+
+(elmo-define-signal cache-changed (number)
+ "Notify the change cache status of the message with NUMBER.")
+
+(elmo-define-signal update-overview (number)
+ "Notify update overview of the message with NUMBER.")
+
;; autoloads
(eval-and-compile
+ (autoload 'md5 "md5")
(autoload 'elmo-dop-queue-flush "elmo-dop")
(autoload 'elmo-nntp-post "elmo-nntp")
(autoload 'elmo-global-flag-p "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))
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 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))
(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)
t)
-(defun elmo-folder-encache (folder numbers &optional unread)
- "Encache messages in the FOLDER with NUMBERS.
-If UNREAD is non-nil, messages are not flaged as read."
- (dolist (number numbers)
- (elmo-message-encache folder number unread)))
-
(luna-define-generic elmo-message-encache (folder number &optional read)
"Encache message in the FOLDER with NUMBER.
If READ is non-nil, message is flaged as read.")
(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.
-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.
-Returns non-nil if fetching was succeed.")
-
-(luna-define-generic elmo-message-fetch-with-cache-process (folder
- number strategy
- &optional
- section
- unread)
- "Fetch a message into current buffer with cache process.
+ 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 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-internal (folder number strategy
(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)
append-list delete-list diff)
(cons (if (equal in-folder in-db)
0
- (setq diff (elmo-list-diff in-folder in-db nil))
+ (setq diff (elmo-list-diff in-folder in-db))
(setq append-list (car diff))
(setq delete-list (cadr diff))
(if append-list
'entire t nil
(elmo-file-cache-path cache)))
(error "Unplugged")))
- nil (current-buffer)
'unread)
(> (buffer-size) 0)
(elmo-folder-append-buffer
folder
- (let ((this-id (elmo-message-field src-folder (car numbers)
- 'message-id)))
- (and this-id
- (string= this-id
- (elmo-msgdb-get-message-id-from-buffer))
- (or (elmo-message-flags src-folder (car numbers))
- '(read))))
+ (elmo-message-flags-for-append src-folder (car numbers))
(if same-number (car numbers))))))
(error (setq failure t)))
;; FETCH & APPEND finished
(or (elmo-folder-path-internal folder)
(elmo-folder-set-path-internal
folder
- (elmo-folder-expand-msgdb-path folder))))
+ (if (null elmo-msgdb-path-encode-threshold)
+ (elmo-folder-expand-msgdb-path folder)
+ (let* ((path (directory-file-name
+ (elmo-folder-expand-msgdb-path folder)))
+ (dirname (file-name-nondirectory path)))
+ (if (<= (length dirname) elmo-msgdb-path-encode-threshold)
+ path
+ (require 'md5)
+ (setq dirname (md5 dirname))
+ (when (> (length dirname) elmo-msgdb-path-encode-threshold)
+ (error "Cannot shrink msgdb path for `%s'"
+ (elmo-folder-name-internal folder)))
+ (expand-file-name dirname (file-name-directory path))))))))
(luna-define-generic elmo-message-cached-p (folder number)
"Return non-nil if the message is cached.")
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-emit-signal 'cache-changed folder number))
(defun elmo-message-copy-entity (entity)
(elmo-msgdb-copy-message-entity (elmo-message-entity-handler entity)
&optional is-local)
(when (elmo-folder-msgdb-internal folder)
(dolist (number numbers)
- (when (elmo-global-flag-p flag)
- (let ((message-id (elmo-message-field folder number 'message-id)))
- (elmo-global-flag-set flag folder number message-id)))
- (elmo-msgdb-set-flag (elmo-folder-msgdb folder)
- number
- flag))
- (elmo-folder-notify-event folder 'flag-changed numbers)))
+ (let ((old-flags (elmo-message-flags folder number)))
+ (when (elmo-global-flag-p flag)
+ (let ((message-id (elmo-message-field folder number 'message-id)))
+ (elmo-global-flag-set flag folder number message-id)))
+ (elmo-msgdb-set-flag (elmo-folder-msgdb folder) number flag)
+ (elmo-emit-signal 'flag-changing
+ folder
+ number
+ old-flags
+ (elmo-message-flags folder number))))
+ (elmo-emit-signal 'flag-changed folder numbers)))
(defun elmo-message-has-global-flag-p (folder number)
"Return non-nil when the message in the FOLDER with NUMBER has global flag."
&optional is-local)
(when (elmo-folder-msgdb-internal folder)
(dolist (number numbers)
- (when (elmo-global-flag-p flag)
- (elmo-global-flag-detach flag folder number 'always))
- (elmo-msgdb-unset-flag (elmo-folder-msgdb folder)
- number
- flag))
- (elmo-folder-notify-event folder 'flag-changed numbers)))
+ (let ((old-flags (elmo-message-flags folder number)))
+ (when (elmo-global-flag-p flag)
+ (elmo-global-flag-detach flag folder number 'always))
+ (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) number flag)
+ (elmo-emit-signal 'flag-changing
+ folder
+ number
+ old-flags
+ (elmo-message-flags folder number))))
+ (elmo-emit-signal 'flag-changed folder numbers)))
(luna-define-method elmo-folder-process-crosspost ((folder elmo-folder))
;; Do nothing.
number strategy)
nil)
+(defun elmo-message-fetch-string (folder number strategy
+ &optional
+ unread
+ section)
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (when (elmo-message-fetch folder number strategy unread section)
+ (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))))
-
-(luna-define-method elmo-message-fetch-with-cache-process ((folder elmo-folder)
- number strategy
- &optional
- section unread)
+ unread
+ section)
+ (erase-buffer)
(let ((cache-path (elmo-fetch-strategy-cache-path strategy))
(method-priorities
(cond ((eq (elmo-fetch-strategy-use-cache strategy) 'maybe)
'(cache entity))
(t
'(entity))))
- result err)
+ result err updated-server-flag)
(while (and method-priorities
- (null result))
+ (not result))
(setq result
(case (car method-priorities)
(cache
(elmo-file-cache-load cache-path section))
(entity
- (when (and (condition-case error
- (elmo-message-fetch-internal folder number
- strategy
- section
- unread)
- (error (setq err error) nil))
- (> (buffer-size) 0))
+ (when (condition-case error
+ (elmo-message-fetch-internal folder number
+ strategy
+ section
+ unread)
+ (error (setq err error) nil))
+ (setq updated-server-flag t)
(when (and (elmo-fetch-strategy-save-cache strategy)
cache-path)
(elmo-file-cache-save cache-path section))
t)))
method-priorities (cdr method-priorities)))
- (or result
- (and err (signal (car err) (cdr err))))))
+ (if result
+ (when (and (not unread)
+ (elmo-message-flagged-p folder number 'unread))
+ (elmo-message-unset-flag folder number 'unread updated-server-flag))
+ (when err
+ (signal (car err) (cdr err))))
+ result))
(defun elmo-folder-kill-messages-range (folder beg end)
(elmo-folder-set-killed-list-internal
(elmo-list-diff (elmo-folder-list-messages folder)
(elmo-folder-list-messages folder nil 'in-msgdb)))
(when diff-new
+ (setq diff-new (sort diff-new #'<))
(unless disable-killed
(setq diff-new (elmo-living-messages diff-new killed-list)))
(when mask
(when (not (eq (length diff-new)
(length new-list)))
(let* ((diff (elmo-list-diff diff-new new-list))
- (disappeared (car diff)))
+ (disappeared (sort (car diff) #'<)))
(when disappeared
(elmo-folder-kill-messages-range folder
(car disappeared)
(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.")
-
-(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."
projects / elisp / wanderlust.git / blobdiff