(require 'elmo-vars)
(require 'elmo-util)
(require 'elmo-msgdb)
+(require 'elmo-signal)
(eval-when-compile (require 'cl))
(defcustom elmo-message-fetch-threshold 30000
"Fetch threshold."
- :type 'integer
+ :type '(choice (integer :tag "Threshold (bytes)")
+ (const :tag "No limitation" nil))
:group 'elmo)
(defcustom elmo-message-fetch-confirm t
(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 status-changed (numbers)
+ "Notify the change status of the message with NUMBERS.")
+
+(elmo-define-signal update-overview (number)
+ "Notify update overview of the message with NUMBER.")
+
+(elmo-define-signal message-number-changed (old-number new-number)
+ "Notify change of message number within the folder.")
+
+;; 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")
+ (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")
+ (autoload 'elmo-global-flag-replace-referrer "elmo-flag")
+ (autoload 'elmo-get-global-flags "elmo-flag")
+ (autoload 'elmo-global-flags-initialize "elmo-flag")
+ (autoload 'elmo-global-mark-migrate "elmo-flag")
+ (autoload 'elmo-folder-list-global-flag-messages "elmo-flag")
+ (autoload 'elmo-search-register-engine "elmo-search"))
+
(defun elmo-define-folder (prefix backend)
"Define a folder.
If a folder name begins with PREFIX, use BACKEND."
(defmacro elmo-folder-type (name)
"Get folder type from NAME string."
- (` (and (stringp (, name))
- (cdr (assoc (string-to-char (, name)) elmo-folder-type-alist)))))
+ `(and (stringp ,name)
+ (cdr (assoc (string-to-char ,name) elmo-folder-type-alist))))
;;; ELMO folder
;; A elmo folder provides uniformed (orchestrated) access
path ; directory path for msgdb.
msgdb ; msgdb (may be nil).
killed-list ; killed list.
+ flag-table ; flag table.
persistent ; non-nil if persistent.
- message-modified ; message is modified.
- mark-modified ; mark is modified.
process-duplicates ; read or hide
biff ; folder for biff
+ mime-charset ; charset for encode & decode
))
(luna-define-internal-accessors 'elmo-folder))
(defmacro elmo-folder-send (folder message &rest args)
"Let FOLDER receive the MESSAGE with ARGS."
- (` (luna-send (, folder) (, message) (, folder) (,@ args))))
+ `(luna-send ,folder ,message ,folder ,@args))
;;;###autoload
-(defun elmo-make-folder (name &optional non-persistent)
+(defun elmo-make-folder (name &optional non-persistent mime-charset)
"Make an ELMO folder structure specified by NAME.
-If optional argument NON-PERSISTENT is non-nil, the folder msgdb is not saved."
+If optional argument NON-PERSISTENT is non-nil, the folder msgdb is not saved.
+If optional argument MIME-CHARSET is specified, it is used for
+encode and decode a multibyte string."
(let ((type (elmo-folder-type name))
prefix split class folder original)
(setq original (elmo-string name))
(if type
(progn
- (setq prefix (substring name 0 1))
- (setq name (substring name 1)))
+ (setq prefix (elmo-string (substring name 0 1)))
+ (setq name (elmo-string (substring name 1))))
(setq type (intern (car (setq split (split-string name ":")))))
- (if (> (length split) 2)
+ (if (>= (length split) 2)
(setq name (substring name (+ 1 (length (car split)))))
(error "Error in folder name `%s'" original))
(setq prefix (concat (car split) ":")))
:type type
:prefix prefix
:name original
- :persistent (not non-persistent)))
+ :persistent (not non-persistent)
+ :mime-charset mime-charset))
(save-match-data
(elmo-folder-send folder 'elmo-folder-initialize name))))
+(defvar elmo-get-folder-function nil)
+
+(defun elmo-get-folder (name)
+ (or (and elmo-get-folder-function
+ (funcall elmo-get-folder-function name))
+ (elmo-make-folder name)))
+
;; Note that this function is for internal use only.
(luna-define-generic elmo-folder-msgdb (folder)
"Return the msgdb of FOLDER (on-demand loading).
(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))))
+ (elmo-folder-msgdb-load folder))))
(luna-define-generic elmo-folder-open (folder &optional load-msgdb)
"Open and setup (load saved status) FOLDER.
(luna-define-generic elmo-folder-reserve-status-p (folder)
"If non-nil, the folder should not close folder after `elmo-folder-status'.")
-(luna-define-generic elmo-folder-set-message-modified (folder modified)
- "Set FOLDER as modified.")
-(luna-define-method elmo-folder-set-message-modified ((folder elmo-folder)
- modified)
- (elmo-folder-set-message-modified-internal folder modified))
-
(luna-define-generic elmo-folder-list-messages (folder &optional visible-only
in-msgdb)
"Return a list of message numbers contained in FOLDER.
(setq list (elmo-msgdb-list-messages (elmo-folder-msgdb folder))))
(if visible-only
(elmo-living-messages list killed-list)
- (elmo-uniq-list
- (nconc (elmo-number-set-to-number-list killed-list) list)))))
-
-(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= 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))
+ (if (and in-msgdb killed-list)
+ (elmo-uniq-sorted-list
+ (sort (nconc (elmo-number-set-to-number-list killed-list) list) #'<)
+ #'eq)
+ list))))
+
+(luna-define-generic elmo-folder-list-messages-internal (folder &optional
+ visible-only)
+ ;; Return a list of message numbers contained in FOLDER.
+ ;; Return t if the message list is not available.
+ )
(luna-define-generic elmo-folder-list-flagged (folder flag &optional in-msgdb)
"List messages in the FOLDER with FLAG.
`important' (marked as important)
'sugar' flags:
`read' (not unread)
- `digest' (unread + important)
- `any' (digest + answered)
-
+ `digest' (unread + important + other flags)
+ `any' (digest + answered + other flags)
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))
+ (let ((msgs (if in-msgdb
+ t
+ (elmo-folder-list-flagged-internal folder flag))))
+ (unless (listp msgs)
+ (setq msgs (elmo-msgdb-list-flagged (elmo-folder-msgdb folder) flag)))
+ (if in-msgdb
+ msgs
+ (elmo-uniq-list
+ (nconc (elmo-folder-list-global-flag-messages folder flag) msgs)
+ #'delq))))
-(luna-define-method elmo-folder-list-answereds ((folder elmo-folder))
- (elmo-folder-list-flagged folder 'answered))
+(luna-define-generic elmo-folder-list-flagged-internal (folder flag)
+ "Return a list of message in the FOLDER with FLAG.
+Return t if the message list is not available.")
-(luna-define-generic elmo-folder-list-messages-internal (folder &optional
- visible-only)
- ;; Return a list of message numbers contained in FOLDER.
- ;; Return t if the message list is not available.
- )
+(luna-define-method elmo-folder-list-flagged-internal ((folder elmo-folder)
+ flag)
+ t)
(luna-define-generic elmo-folder-list-subfolders (folder &optional one-level)
"Returns a list of subfolders contained in 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.")
+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.
NUMBERS is a list of message numbers to create msgdb.
FLAG-TABLE is a hashtable of message-id and flag.")
-(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.
-If IGNORE-FLAGS is non-nil, folder flags are not updated.")
+(luna-define-generic elmo-folder-set-flag (folder numbers flag
+ &optional is-local)
+ "Set messages flag.
+FOLDER is a ELMO folder structure.
+NUMBERS is a list of message number to set flag.
-(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.
-If IGNORE-FLAGS is non-nil, folder flags are not updated.")
+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)
+If optional IS-LOCAL is non-nil, update only local (not server) status.")
-(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.
-If IGNORE-FLAGS is non-nil, folder flags are not updated.")
+(luna-define-generic elmo-folder-unset-flag (folder numbers flag
+ &optional is-local)
+ "Unset messages flag.
+FOLDER is a ELMO folder structure.
+NUMBERS is a list of message number to unset flag.
-(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.")
+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)
+ `all' (remove all flags)
+If optional IS-LOCAL is non-nil, update only local (not server) status.")
-(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-message-flag-available-p (folder number flag)
+ "Return non-nil when a message in the FOLDER with NUMBER treats FLAG.")
-(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-next-message-number (folder)
+ "The next message number that will be assigned to a new message.
+FOLDER is the ELMO folder structure.")
-(luna-define-generic elmo-folder-append-buffer (folder &optional flag
+(luna-define-generic elmo-folder-append-buffer (folder &optional flags
number)
"Append current buffer as a new message.
-FOLDER is the destination folder(ELMO folder structure).
-FLAG is the status of appended message.
+FOLDER is the destination folder (ELMO folder structure).
+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\).")
-
-(luna-define-generic elmo-folder-append-messages (folder
- src-folder
- numbers
- &optional
- same-number)
- "Append messages from folder.
-FOLDER is the ELMO folder structure.
-Caller should make sure FOLDER is `writable'.
-(Can be checked with `elmo-folder-writable-p').
-SRC-FOLDER is the source ELMO folder structure.
-NUMBERS is the message numbers to be appended in the SRC-FOLDER.
-If second optional argument SAME-NUMBER is specified,
-message number is preserved \(if possible\).")
+\(if possible\).
+Return nil on failure.")
(luna-define-generic elmo-folder-pack-numbers (folder)
"Pack message numbers of FOLDER.")
(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-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-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 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)
+ (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.
+FOLDER is a ELMO folder structure.
+NUMBER is a message number to test."
+ (let ((cur-flags (elmo-message-flags folder number)))
+ (case flag
+ (read
+ (not (memq 'unread cur-flags)))
+ (t
+ (memq flag cur-flags)))))
+
+(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-msgdb-overview-entity-get-size entity))
- (setq message-id (elmo-msgdb-overview-entity-get-id entity))
- (setq number (elmo-msgdb-overview-entity-get-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 marked 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 marked as read.")
+If READ is non-nil, message is flaged as read.")
(luna-define-method elmo-message-encache ((folder elmo-folder) number
&optional read)
- (elmo-message-fetch
- folder number
- (elmo-make-fetch-strategy 'entire
- nil ;use-cache
- t ;save-cache
- (elmo-file-cache-get-path
- (elmo-message-field
- folder number 'message-id)))
- nil nil (not read)))
+ (let (path)
+ (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)
+ "Fetch bodystructure of the message in FOLDER with NUMBER using 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 marked 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 marked 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
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 marked as read.
+If second 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-field (folder number field)
(luna-define-generic elmo-folder-process-crosspost (folder)
"Process crosspost for FOLDER.
-Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
+Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).")
(luna-define-generic elmo-folder-newsgroups (folder)
"Return list of newsgroup name of FOLDER.")
(defun elmo-generic-folder-commit (folder)
(when (elmo-folder-persistent-p folder)
- (when (elmo-folder-message-modified-internal folder)
- (elmo-msgdb-overview-save
- (elmo-folder-msgdb-path folder)
- (elmo-msgdb-get-overview (elmo-folder-msgdb folder)))
- (elmo-msgdb-number-save
- (elmo-folder-msgdb-path folder)
- (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder)))
- (elmo-folder-set-info-max-by-numdb
- folder
- (elmo-folder-list-messages folder nil 'in-msgdb))
- (elmo-folder-set-message-modified folder nil)
- (elmo-msgdb-killed-list-save
- (elmo-folder-msgdb-path folder)
- (elmo-folder-killed-list-internal folder)))
- (when (elmo-folder-mark-modified-internal folder)
- (elmo-msgdb-mark-save
- (elmo-folder-msgdb-path folder)
- (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))
- (elmo-folder-set-mark-modified-internal folder nil))))
+ (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.
t))
(luna-define-method elmo-folder-rename ((folder elmo-folder) new-name)
- (let* ((new-folder (elmo-make-folder new-name)))
+ (let ((new-folder (elmo-make-folder
+ new-name
+ nil
+ (elmo-folder-mime-charset-internal folder))))
(unless (eq (elmo-folder-type-internal folder)
(elmo-folder-type-internal new-folder))
(error "Not same folder type"))
- (if (or (file-exists-p (elmo-folder-msgdb-path new-folder))
- (elmo-folder-exists-p new-folder))
- (error "Already exists folder: %s" new-name))
+ (when (or (file-exists-p (elmo-folder-msgdb-path new-folder))
+ (elmo-folder-exists-p new-folder))
+ (error "Already exists folder: %s" new-name))
(elmo-folder-send folder 'elmo-folder-rename-internal new-folder)
+ (elmo-global-flag-replace-referrer (elmo-folder-name-internal folder)
+ new-name)
(elmo-msgdb-rename-path folder new-folder)))
-(defsubst elmo-folder-search-fast (folder condition 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-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)
(let ((numbers (or numbers (elmo-folder-list-messages folder)))
+ (msgdb (elmo-folder-msgdb folder))
results)
- (if (listp (setq results (elmo-folder-search-fast folder
- condition
- numbers)))
+ (setq results (elmo-msgdb-search msgdb condition numbers))
+ (if (listp results)
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))
+ (elmo-condition-optimize condition)
+ (when (and (consp condition)
+ (eq (car condition) 'and)
+ (listp (setq results (elmo-msgdb-search msgdb
+ (nth 1 condition)
+ numbers))))
+ (setq numbers results
+ condition (nth 2 condition)))
+ (let (matched)
+ (elmo-with-progress-display (elmo-folder-search (length numbers))
+ "Searching messages"
+ (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)))
(nreverse matched)))))
+(defun elmo-message-buffer-match-condition (condition number)
+ (let* ((handler (luna-make-entity 'modb-buffer-entity-handler))
+ (result (elmo-condition-match
+ condition
+ (lambda (condition handler entity)
+ (elmo-msgdb-message-match-condition handler
+ condition
+ entity))
+ (list
+ handler
+ (elmo-msgdb-make-message-entity
+ handler
+ :number number
+ :buffer (current-buffer))))))
+ (and result (not (elmo-filter-condition-p result)))))
+
(luna-define-method elmo-message-match-condition ((folder elmo-folder)
number condition
numbers)
- (let ((filename (cond
- ((elmo-message-file-name folder number))
- ((let* ((cache (elmo-file-cache-get
- (elmo-message-field folder number
- 'message-id)))
- (cache-path (elmo-file-cache-path cache)))
- (when (and cache-path
- (not (elmo-cache-path-section-p cache-path)))
- cache-path))))))
- (when (and filename
- (file-readable-p filename))
+ (let* (cache cache-path
+ (filename (cond
+ ((elmo-message-file-name folder number))
+ ((progn
+ (setq cache (elmo-file-cache-get
+ (elmo-message-field folder number
+ 'message-id)))
+ (setq cache-path (elmo-file-cache-path cache))
+ (and cache-path
+ (not (elmo-cache-path-section-p cache-path))))
+ cache-path))))
+ (when (and filename (file-readable-p filename))
(with-temp-buffer
- (insert-file-contents-as-binary filename)
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
- ;; Should consider charset?
- (decode-mime-charset-region (point-min) (point-max) elmo-mime-charset)
- (elmo-buffer-field-condition-match condition number numbers)))))
+ (set-buffer-multibyte nil)
+;;; (insert-file-contents-as-binary filename)
+ (elmo-message-fetch folder number
+ (elmo-make-fetch-strategy 'entire
+ (and cache t)
+ nil
+ cache-path)
+ 'unread)
+ (set-buffer-multibyte default-enable-multibyte-characters)
+ (decode-coding-region (point-min) (point-max)
+ elmo-mime-display-as-is-coding-system)
+ (elmo-message-buffer-match-condition condition number)))))
(luna-define-method elmo-folder-pack-numbers ((folder elmo-folder))
nil) ; default is noop.
(luna-define-method elmo-folder-have-subfolder-p ((folder elmo-folder))
t)
+;; Flag table
+(luna-define-generic elmo-folder-flag-table (folder &optional if-exists)
+ "Return the flag-table of FOLDER.
+If optional argument IF-EXISTS is nil, load on demand.
+\(For internal use only.\)")
+
+(luna-define-generic elmo-folder-close-flag-table (folder)
+ "Close flag-table of FOLDER.")
+
+(luna-define-method elmo-folder-flag-table ((folder elmo-folder)
+ &optional if-exists)
+ (or (elmo-folder-flag-table-internal folder)
+ (unless if-exists
+ (elmo-folder-set-flag-table-internal
+ folder
+ (elmo-flag-table-load (elmo-folder-msgdb-path folder))))))
+
+(luna-define-method elmo-folder-close-flag-table ((folder elmo-folder))
+ (elmo-flag-table-save (elmo-folder-msgdb-path folder)
+ (elmo-folder-flag-table folder))
+ (elmo-folder-set-flag-table-internal folder nil))
+
+(defun elmo-folder-preserve-flags (folder msgid flags)
+ "Preserve FLAGS into FOLDER for a message that has MSGID."
+ (when (and msgid flags)
+ (let ((flag-table (elmo-folder-flag-table folder 'if-exists))
+ load-now)
+ (when (setq load-now (null flag-table))
+ (setq flag-table (elmo-folder-flag-table folder)))
+ (elmo-flag-table-set flag-table msgid flags)
+ (when load-now
+ (elmo-folder-close-flag-table folder)))))
+
;;; Folder info
;; Folder info is a message number information cache (hashtable)
(defsubst elmo-folder-get-info (folder &optional hashtb)
"Set FOLDER info by MSGDB-NUMBER in msgdb."
(elmo-folder-set-info-hashtb
folder
- (or (car (sort numbers '>)) 0)
- nil ;;(length num-db)
+ (if numbers (apply #'max numbers) 0)
+;;; (length num-db)
+ nil
))
(defun elmo-folder-get-info-max (folder)
"Setup folder info hashtable by INFO-ALIST on HASHTB."
(let* ((hashtb (or hashtb
(elmo-make-hash (length info-alist)))))
- (mapcar
+ (mapc
(lambda (x)
(let ((info (cadr x)))
(and (intern-soft (car x) hashtb)
(defsubst elmo-strict-folder-diff (folder)
"Return folder diff information strictly from FOLDER."
- (let ((in-db (sort (elmo-msgdb-list-messages (elmo-folder-msgdb folder))
- '<))
+ (let ((in-db (sort (elmo-folder-list-messages folder nil 'in-msgdb) '<))
(in-folder (elmo-folder-list-messages folder))
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
(let ((number-list (elmo-folder-list-messages folder
nil 'in-msgdb)))
;; No info-cache.
- (setq in-db (sort number-list '<))
- (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db)
- 0))
+ (setq in-db number-list)
+ (setq in-db-max (if in-db (apply #'max in-db) 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))
(luna-define-method elmo-folder-contains-type ((folder elmo-folder) type)
(eq (elmo-folder-type-internal folder) type))
-(luna-define-method elmo-folder-append-messages ((folder elmo-folder)
- src-folder
- numbers
- &optional
- same-number)
- (elmo-generic-folder-append-messages folder src-folder numbers
- same-number))
+(luna-define-method elmo-folder-next-message-number ((folder elmo-folder))
+ (+ 1 (elmo-max-of-list (or (elmo-folder-list-messages folder)
+ '(0)))))
+
+(eval-and-compile
+ (luna-define-class elmo-file-tag))
+
+(defconst elmo-append-messages-dispatch-table
+ '(((nil . null) . elmo-folder-append-messages-*-null)
+ ((filter . nil) . elmo-folder-append-messages-filter-*)
+ ((nil . filter) . elmo-folder-append-messages-*-filter)
+ ((pipe . nil) . elmo-folder-append-messages-pipe-*)
+ ((nil . pipe) . elmo-folder-append-messages-*-pipe)
+ ((multi . nil) . elmo-folder-append-messages-multi-*)
+ ((nil . flag) . elmo-folder-append-messages-*-flag)
+ ((imap4 . imap4) . elmo-folder-append-messages-imap4-imap4)
+ ((elmo-file-tag . localdir) . elmo-folder-append-messages-*-localdir)
+ ((elmo-file-tag . maildir) . elmo-folder-append-messages-*-maildir)
+ ((nil . archive) . elmo-folder-append-messages-*-archive)
+ ((nil . nil) . elmo-generic-folder-append-messages)))
+
+(defun elmo-folder-type-p (folder type)
+ (or (null type)
+ (eq (elmo-folder-type-internal folder) type)
+ (labels ((member-if (predicate list)
+ (and list
+ (or (funcall predicate (car list))
+ (member-if predicate (cdr list)))))
+ (subtypep (name type)
+ (or (eq name type)
+ (let ((class (luna-find-class name)))
+ (and class
+ (member-if (lambda (name)
+ (subtypep name type))
+ (luna-class-parents class)))))))
+ (subtypep (luna-class-name folder)
+ (or (intern-soft (format "elmo-%s-folder" type))
+ type)))))
+
+(defun elmo-folder-append-messages (dst-folder src-folder numbers
+ &optional same-number caller)
+ "Append messages from folder.
+DST-FOLDER is the ELMO folder structure.
+Caller should make sure DST-FOLDER is `writable'.
+\(Can be checked with `elmo-folder-writable-p'\).
+SRC-FOLDER is the source ELMO folder structure.
+NUMBERS is the message numbers to be appended in the SRC-FOLDER.
+If second optional argument SAME-NUMBER is specified,
+message number is preserved \(if possible\).
+Returns a list of message numbers successfully appended."
+ (let ((rest (if caller
+ (cdr (memq (rassq caller elmo-append-messages-dispatch-table)
+ elmo-append-messages-dispatch-table))
+ elmo-append-messages-dispatch-table))
+ result)
+ (while rest
+ (let ((types (car (car rest))))
+ (if (and (elmo-folder-type-p src-folder (car types))
+ (elmo-folder-type-p dst-folder (cdr types)))
+ (setq result (funcall (cdr (car rest))
+ dst-folder src-folder numbers same-number)
+ rest nil)
+ (setq rest (cdr rest)))))
+ result))
(defun elmo-generic-folder-append-messages (folder src-folder numbers
same-number)
(let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
- unseen table flags
+ unseen
succeed-numbers failure cache id)
- (setq table (elmo-flag-table-load (elmo-folder-msgdb-path folder)))
+ (elmo-folder-flag-table folder) ; load
(with-temp-buffer
(set-buffer-multibyte nil)
(while numbers
(setq failure nil
id (and src-msgdb-exists
(elmo-message-field src-folder (car numbers)
- 'message-id))
- flags (elmo-message-flags src-folder (car numbers)))
+ 'message-id)))
(condition-case nil
(setq cache (elmo-file-cache-get id)
failure
'entire t nil
(elmo-file-cache-path cache)))
(error "Unplugged")))
- nil (current-buffer)
'unread)
(> (buffer-size) 0)
(elmo-folder-append-buffer
folder
- flags
+ (elmo-message-flags-for-append src-folder (car numbers))
(if same-number (car numbers))))))
(error (setq failure t)))
;; FETCH & APPEND finished
(unless failure
- (when id
- (elmo-flag-table-set table id flags))
(setq succeed-numbers (cons (car numbers) succeed-numbers)))
(elmo-progress-notify 'elmo-folder-move-messages)
(setq numbers (cdr numbers)))
(when (elmo-folder-persistent-p folder)
- (elmo-flag-table-save (elmo-folder-msgdb-path folder) table))
+ (elmo-folder-close-flag-table folder))
succeed-numbers)))
;; Arguments should be reduced.
same-number)
(save-excursion
(let* ((messages msgs)
- (elmo-inhibit-display-retrieval-progress t)
(len (length msgs))
succeeds i result)
(if (eq dst-folder 'null)
(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))
- (setq result t)
+ (if (elmo-folder-delete-messages src-folder succeeds)
+ (progn
+ (elmo-global-flag-detach-messages
+ src-folder succeeds (eq dst-folder 'null))
+ (setq result t))
(message "move: delete messages from %s failed."
(elmo-folder-name-internal src-folder))
(setq result nil))
result)
(if no-delete
(progn
- ;; (message "Copying messages...done")
+;;; (message "Copying messages...done")
t)
(if (eq len 0)
(message "No message was moved.")
(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.")
(luna-define-method elmo-message-cached-p ((folder elmo-folder) number)
- (elmo-msgdb-get-cached (elmo-folder-msgdb folder) number))
+ (elmo-message-flagged-p folder number 'cached))
+
+(luna-define-generic elmo-message-killed-p (folder number)
+ "Return non-nil if the message is killed.")
+
+(luna-define-method elmo-message-killed-p ((folder elmo-folder) number)
+ (let ((killed-list (elmo-folder-killed-list-internal folder)))
+ (and killed-list
+ (elmo-number-set-member number killed-list))))
(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)
+ (< number 0) ; in dop spool
(elmo-message-cached-p folder number)))
(luna-define-generic elmo-message-set-cached (folder number cached)
(luna-define-method elmo-message-set-cached ((folder elmo-folder)
number 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)))
+ (if cached
+ (elmo-msgdb-set-flag (elmo-folder-msgdb folder) number 'cached)
+ (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) number 'cached))
+ (elmo-emit-signal 'status-changed folder (list number)))
(defun elmo-message-copy-entity (entity)
- ;;
- (elmo-msgdb-copy-overview-entity entity))
+ (elmo-msgdb-copy-message-entity (elmo-message-entity-handler entity)
+ entity))
-(defun elmo-message-entity-set-number (entity number)
- (elmo-msgdb-overview-entity-set-number entity number))
+(luna-define-generic elmo-message-number (folder message-id)
+ "Get message number from MSGDB which corresponds to MESSAGE-ID.")
+
+(luna-define-method elmo-message-number ((folder elmo-folder) message-id)
+ (elmo-msgdb-message-number (elmo-folder-msgdb folder) message-id))
(luna-define-generic elmo-message-entity (folder key)
"Return the message-entity structure which matches to the KEY.
`(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')")
+Return alist of flag and numbers.
+Example:
+\(\(new . 10\)
+ \(unread . 20\)
+ \(answered . 3\)\)")
(luna-define-method elmo-folder-count-flags ((folder elmo-folder))
- (let ((new 0)
- (unreads 0)
- (answered 0)
- flags)
- (dolist (number (elmo-folder-list-messages folder 'visible 'in-msgdb))
- (setq flags (elmo-message-flags folder number))
- (cond
- ((memq 'new flags)
- (incf new))
- ((memq 'unread flags)
- (incf unreads))
- ((memq 'answered flags)
- (incf answered))))
- (list new unreads answered)))
-
-(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.")
-
-(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.
-FOLDER is a ELMO folder structure.
-NUMBER is a message number to test."
- (let ((cur-flags (elmo-message-flags folder number)))
- (case flag
- (read
- (not (memq 'unread cur-flags)))
- (t
- (memq flag cur-flags)))))
+ (elmo-msgdb-flag-count (elmo-folder-msgdb folder)))
-(defun elmo-message-set-flag (folder number flag)
+(defun elmo-message-set-flag (folder number flag &optional is-local)
"Set message flag.
FOLDER is a ELMO folder structure.
NUMBER is a message number to set flag.
`answered' (set the message as answered)
`important' (set the message as important)
'sugar' flag:
- `read' (remove new and unread flags)")
+ `read' (remove new and unread flags)
+If optional IS-LOCAL is non-nil, update only local (not server) status."
+ ;; XXX Transitional implementation.
+ (elmo-folder-set-flag folder (list number) flag is-local))
-(defun elmo-message-unset-flag (folder number flag)
+(defun elmo-message-unset-flag (folder number flag &optional is-local)
"Unset message flag.
FOLDER is a ELMO folder structure.
NUMBER is a message number to set flag.
`answered' (remove answered flag)
`important' (remove important flag)
'sugar' flag:
- `read' (set unread flag)")
+ `read' (set unread flag)
+If optional IS-LOCAL is non-nil, update only local (not server) status."
+ ;; XXX Transitional implementation.
+ (elmo-folder-unset-flag folder (list number) flag is-local))
-(luna-define-generic elmo-message-field (folder number field)
+(luna-define-generic elmo-message-field (folder number field &optional type)
"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.")
+FIELD is a symbol of the field.
+If optional argument TYPE is specified, return converted value.")
+
+(luna-define-method elmo-message-field ((folder elmo-folder)
+ number field &optional type)
+ (elmo-msgdb-message-field (elmo-folder-msgdb folder) number field type))
+
+(luna-define-generic elmo-message-set-field (folder number field value)
+ "Set 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.
+VALUE is a value to set.")
-(luna-define-method elmo-message-field ((folder elmo-folder) number field)
- (when (zerop (elmo-folder-length folder))
- (error "Cannot treat this folder correctly."))
- (elmo-msgdb-get-field (elmo-folder-msgdb folder) number field))
+(luna-define-method elmo-message-set-field ((folder elmo-folder) number
+ field value)
+ (elmo-message-entity-set-field (elmo-message-entity folder number)
+ field value))
(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
- &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
- &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)
+(luna-define-method elmo-folder-set-flag ((folder elmo-folder)
+ numbers
+ flag
+ &optional is-local)
(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)
+ (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."
+ (let ((flags (elmo-message-flags folder number))
+ result)
+ (while flags
+ (when (and (elmo-global-flag-p (car flags))
+ (not (memq (car flags) '(answered unread cached))))
+ (setq result t
+ flags nil))
+ (setq flags (cdr flags)))
+ result))
+
+(defun elmo-message-set-global-flags (folder number flags &optional local)
+ "Set global flags of the message in the FOLDER with NUMBER as FLAGS.
+If Optional LOCAL is non-nil, don't update server flag."
+ (dolist (flag flags)
+ (unless (elmo-global-flag-p flag)
+ (error "Not a global flag")))
+ (let ((old-flags (elmo-get-global-flags (elmo-message-flags folder number))))
+ (dolist (flag flags)
+ (unless (memq flag old-flags)
+ (elmo-message-set-flag folder number flag local)))
+ (dolist (flag old-flags)
+ (unless (memq flag flags)
+ (elmo-message-unset-flag folder number flag local)))))
+
+(luna-define-method elmo-folder-unset-flag ((folder elmo-folder)
+ numbers
+ flag
+ &optional is-local)
(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))))
+ (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.
)
-;;(luna-define-generic elmo-folder-append-message-entity (folder entity
-;; &optional
-;; flag-table)
-;; "Append ENTITY to the folder.")
+;;;(luna-define-generic elmo-folder-append-message-entity (folder entity
+;;; &optional
+;;; flag-table)
+;;; "Append ENTITY to the folder.")
+
+(defun elmo-msgdb-merge (folder msgdb-merge)
+ "Return a list of messages which have duplicated message-id."
+ (let (msgdb duplicates)
+ (setq msgdb (or (elmo-folder-msgdb-internal folder)
+ (elmo-make-msgdb (elmo-folder-msgdb-path folder))))
+ (setq duplicates (elmo-msgdb-append msgdb msgdb-merge))
+ (elmo-folder-set-msgdb-internal folder msgdb)
+ duplicates))
(defsubst elmo-folder-append-msgdb (folder append-msgdb)
(if append-msgdb
'hide)
;; Let duplicates be a temporary killed message.
(elmo-folder-kill-messages folder duplicates)
- ;; Should be mark as read.
- (elmo-folder-mark-as-read folder duplicates))
+ ;; Should be flag as read.
+ (elmo-folder-unset-flag folder duplicates 'unread))
((eq (elmo-folder-process-duplicates-internal folder)
'read)
- ;; Mark as read duplicates.
- (elmo-folder-mark-as-read folder duplicates))
+ ;; Flag as read duplicates.
+ (elmo-folder-unset-flag folder duplicates 'unread))
(t
;; Do nothing.
(setq duplicates nil)))
(length duplicates))
0))
-(defun elmo-folder-confirm-appends (appends)
+(defun elmo-folder-confirm-appends (folder appends)
(let ((len (length appends))
in)
(if (and elmo-folder-update-threshold
(> len elmo-folder-update-threshold)
elmo-folder-update-confirm)
- (if (y-or-n-p (format "Too many messages(%d). Update all? " len))
+ (if (y-or-n-p (format
+ "Too many messages(%d) in %s. Update all? "
+ len (elmo-folder-name-internal folder)))
appends
(setq in elmo-folder-update-threshold)
(catch 'end
(while t
(setq in (read-from-minibuffer "Update number: "
- (int-to-string in))
- in (string-to-int in))
+ (number-to-string in))
+ in (string-to-number in))
(if (< len in)
(throw 'end len))
(if (y-or-n-p (format
(nthcdr (max (- len elmo-folder-update-threshold) 0) appends)
appends))))
+(luna-define-method elmo-message-fetch-bodystructure ((folder elmo-folder)
+ 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))
- (elmo-delete-cr-buffer)
+ (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))))))
-
-(defun elmo-folder-kill-messages-before (folder msg)
+ (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
folder
- (list (cons 1 msg))))
+ (nconc
+ (elmo-folder-killed-list-internal folder)
+ (list (cons beg end)))))
(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)))
+ (elmo-number-set-append-list
+ (elmo-folder-killed-list-internal folder)
+ numbers))
+ (elmo-folder-unset-flag folder numbers 'all 'local-only))
+
+(luna-define-generic elmo-folder-recover-messages (folder numbers)
+ "Recover killed messages in the FOLDER with NUMBERS.")
+(luna-define-method elmo-folder-recover-messages ((folder elmo-folder) numbers)
+ (let ((msgdb (elmo-folder-msgdb folder)))
+ (elmo-folder-set-killed-list-internal
+ folder
+ (elmo-number-set-delete-list
+ (elmo-folder-killed-list-internal folder)
+ numbers))
+ (dolist (number numbers)
+ (if (elmo-file-cache-exists-p
+ (elmo-message-field folder number 'message-id))
+ (elmo-msgdb-set-flag msgdb number 'cached)
+ (elmo-msgdb-unset-flag msgdb number 'cached)))
+ (elmo-emit-signal 'status-changed 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)))
+ (if (eq elmo-msgdb-convert-type 'sync)
+ (elmo-folder-set-msgdb-internal
+ folder
+ (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
+ (elmo-msgdb-clear (elmo-folder-msgdb folder))))
(luna-define-generic elmo-folder-synchronize (folder
&optional
disable-killed
ignore-msgdb
- no-check)
+ no-check
+ mask)
"Synchronize the folder data to the newest status.
FOLDER is the ELMO folder structure.
If optional IGNORE-MSGDB is non-nil, current msgdb is thrown away except
flag status.
If NO-CHECK is non-nil, rechecking folder is skipped.
-Return a list of a cross-posted message number.
+If optional argument MASK is specified and is a list of message numbers,
+synchronize messages only which are contained the list.
+Return amount of cross-posted messages.
If update process is interrupted, return nil.")
(luna-define-method elmo-folder-synchronize ((folder elmo-folder)
&optional
disable-killed
ignore-msgdb
- no-check)
- (let ((killed-list (elmo-folder-killed-list-internal folder))
- (before-append t)
- old-msgdb diff diff-2 delete-list new-list new-msgdb mark
- flag-table crossed after-append)
- (setq old-msgdb (elmo-folder-msgdb folder))
- (setq flag-table (elmo-flag-table-load (elmo-folder-msgdb-path folder)))
+ no-check
+ mask)
+ (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)))
+ (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
+ (setq diff-new (sort diff-new #'<))
+ (unless disable-killed
+ (setq diff-new (elmo-living-messages diff-new killed-list)))
+ (when (and mask (not ignore-msgdb))
+ (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-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))
- (and (eq (length (car diff)) 0)
- (eq (length (cadr diff)) 0)))
+ (setq new-list (elmo-folder-confirm-appends folder 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 (sort (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
(setq before-append nil)
(setq crossed (elmo-folder-append-msgdb folder new-msgdb))
;; process crosspost.
- ;; Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).
- (elmo-folder-process-crosspost folder)
- (elmo-folder-set-message-modified folder t)
- (elmo-folder-set-mark-modified-internal folder t))
+ ;; Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).
+ (elmo-folder-process-crosspost folder))
;; return value.
(or crossed 0)))
(quit
(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-msgdb-length (elmo-folder-msgdb folder))
0))
-(defun elmo-msgdb-load (folder &optional silent)
+(defun elmo-folder-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))))
+ (let ((msgdb (elmo-load-msgdb (elmo-folder-msgdb-path folder)
+ (elmo-folder-mime-charset-internal folder))))
(elmo-folder-set-info-max-by-numdb
folder
(elmo-msgdb-list-messages msgdb))
(while alist
(setq newsgroups
(elmo-delete-if
- '(lambda (x)
- (not (intern-soft x elmo-newsgroups-hashtb)))
+ (lambda (x)
+ (not (intern-soft x elmo-newsgroups-hashtb)))
(nth 1 (car alist))))
(if newsgroups
(setcar (cdar alist) newsgroups)
(elmo-make-directory temp-dir)
temp-dir))
+;; ELMO status structure.
+(defmacro elmo-message-status (folder number &optional flags killed)
+ "Make ELMO status structure from FOLDER and NUMBER.
+A value in this structure is cached at first access."
+ `(vector ,folder ,number ,flags ,killed))
+
+(defmacro elmo-message-status-folder (status)
+ `(aref ,status 0))
+
+(defmacro elmo-message-status-number (status)
+ `(aref ,status 1))
+
+(defmacro elmo-message-status-set-flags (status flags)
+ `(aset ,status 2 (or ,flags '(read))))
+
+(defsubst elmo-message-status-flags (status)
+ (or (aref status 2)
+ (elmo-message-status-set-flags
+ status
+ (elmo-message-flags (elmo-message-status-folder status)
+ (elmo-message-status-number status)))))
+
+(defsubst elmo-message-status-cached-p (status)
+ (memq 'cached (elmo-message-status-flags status)))
+
+(defmacro elmo-message-status-set-killed (status killed)
+ `(aset ,status 3 (if ,killed 'killed 'living)))
+
+(defsubst elmo-message-status-killed-p (status)
+ (eq 'killed
+ (or (aref status 3)
+ (elmo-message-status-set-killed
+ status
+ (elmo-message-killed-p (elmo-message-status-folder status)
+ (elmo-message-status-number status))))))
+
+;;;
(defun elmo-init ()
"Initialize ELMO module."
(elmo-crosspost-message-alist-load)
(elmo-resque-obsolete-variables)
- (elmo-dop-queue-load))
+ (elmo-dop-queue-load)
+ (run-hooks 'elmo-init-hook))
(defun elmo-quit ()
"Quit and cleanup ELMO."
(while types
(setq class
(luna-find-class
- (intern (format "elmo-%s-folder" (symbol-name (cdr (car types)))))))
+ (intern (format "elmo-%s-folder"
+ (symbol-name (cdr (car types)))))))
;; Call all folder's `elmo-quit' method.
(if class
(dolist (func (luna-class-find-functions class 'elmo-quit))
(elmo-define-folder ?| 'pipe)
(elmo-define-folder ?. 'maildir)
(elmo-define-folder ?' 'internal)
-(elmo-define-folder ?\[ 'nmz)
+(elmo-define-folder ?\[ 'search)
(elmo-define-folder ?@ 'shimbun)
;;; Obsolete variables.
'elmo-cache-directory)
(elmo-define-obsolete-variable 'elmo-msgdb-dir
'elmo-msgdb-directory)
+(elmo-define-obsolete-variable 'elmo-global-flag-list
+ 'elmo-global-flags)
+(elmo-define-obsolete-variable 'elmo-nmz-default-index-path
+ 'elmo-search-namazu-default-index-path)
+(elmo-define-obsolete-variable 'elmo-nmz-index-alias-alist
+ 'elmo-search-namazu-index-alias-alist)
+(elmo-define-obsolete-variable 'elmo-nmz-use-drive-letter
+ 'elmo-search-use-drive-letter)
+
;; Obsolete functions.
;; 2001-12-11: *-dir -> *-directory
(make-obsolete 'elmo-folder-make-temp-dir
'elmo-folder-make-temporary-directory)
-
-;; autoloads
-(autoload 'elmo-dop-queue-flush "elmo-dop")
-(autoload 'elmo-nntp-post "elmo-nntp")
-
(require 'product)
(product-provide (provide 'elmo) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff