X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo.el;h=3b3e707f30a0dac9c30f3a98258338b7e7a7bb24;hb=refs%2Fheads%2Fmaster;hp=81c9adeffcc4b8538f851a97b2113512363de6e2;hpb=1400571ea88e7d1094c2ed232ec4a3002bf7c9f5;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo.el b/elmo/elmo.el index 81c9ade..3b3e707 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -35,6 +35,7 @@ (require 'elmo-vars) (require 'elmo-util) (require 'elmo-msgdb) +(require 'elmo-signal) (eval-when-compile (require 'cl)) @@ -46,7 +47,8 @@ (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 @@ -58,7 +60,8 @@ Otherwise, entire fetching of the message is aborted without confirmation." (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 @@ -66,6 +69,12 @@ Otherwise, entire fetching of the message is aborted without confirmation." :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.") @@ -79,6 +88,39 @@ Otherwise, entire fetching of the message is aborted without confirmation." (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." @@ -92,8 +134,8 @@ 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 @@ -105,11 +147,11 @@ If a folder name begins with PREFIX, use BACKEND." 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. - flag-modified ; flag is modified. process-duplicates ; read or hide biff ; folder for biff + mime-charset ; charset for encode & decode )) (luna-define-internal-accessors 'elmo-folder)) @@ -119,19 +161,21 @@ If a folder name begins with PREFIX, use BACKEND." (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) (setq name (substring name (+ 1 (length (car split))))) @@ -143,10 +187,18 @@ If optional argument NON-PERSISTENT is non-nil, the folder msgdb is not saved." :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). @@ -205,12 +257,6 @@ Return value is cons cell or list: (luna-define-generic elmo-folder-reserve-status-p (folder) "If non-nil, the folder should not close folder after `elmo-folder-status'.") -(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. @@ -228,15 +274,17 @@ If second optional IN-MSGDB is non-nil, only messages in the msgdb are listed.") (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))))) + (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-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.") +(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. @@ -247,30 +295,30 @@ FLAG is a symbol which is one of the following: `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. @@ -306,12 +354,18 @@ Otherwise, all descendent folders are returned.") "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. @@ -333,69 +387,52 @@ FOLDER is the ELMO folder structure. 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-unflag-important (folder - numbers - &optional is-local) - "Un-flag messages as important. -FOLDER is the ELMO folder structure. -NUMBERS is a list of message numbers to be processed. -If IS-LOCAL is non-nil, only the local flag is 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-flag-as-important (folder - numbers - &optional is-local) - "Flag messages as important. -FOLDER is the ELMO folder structure. -NUMBERS is a list of message numbers to be processed. -If IS-LOCAL is non-nil, only the local flag is 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-unflag-read (folder numbers - &optional is-local) - "Un-flag messages as read. -FOLDER is the ELMO folder structure. -NUMBERS is a list of message numbers to be processed. -If IS-LOCAL is non-nil, only the local flag is 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-flag-as-read (folder numbers - &optional is-local) - "Flag messages as read. -FOLDER is the ELMO folder structure. -NUMBERS is a list of message numbers to be processed. -If IS-LOCAL is non-nil, only the local flag is 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-unflag-answered (folder numbers - &optional is-local) - "Un-flag messages as answered. -FOLDER is the ELMO folder structure. -If IS-LOCAL is non-nil, only the local flag is updated.") +(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-flag-as-answered (folder numbers - &optional is-local) - "Flag messages as answered. -FOLDER is the ELMO folder structure. -If IS-LOCAL is non-nil, only the local flag is updated.") +(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.") @@ -453,97 +490,130 @@ Return newly created temporary directory name which contains temporary files.") (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 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.") @@ -551,45 +621,32 @@ 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) + "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 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 @@ -663,18 +720,17 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (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-folder-set-message-modified folder nil) - (elmo-folder-set-flag-modified-internal folder nil) - (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. @@ -715,115 +771,106 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") 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. @@ -850,6 +897,39 @@ NUMBERS is a list of message numbers, messages are searched from the list." (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) @@ -873,8 +953,9 @@ NUMBERS is a list of message numbers, messages are searched from the list." "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) @@ -893,7 +974,7 @@ NUMBERS is a list of message numbers, messages are searched from the list." "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) @@ -920,13 +1001,12 @@ NUMBERS is a list of message numbers, messages are searched from the list." (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 @@ -952,9 +1032,8 @@ NUMBERS is a list of message numbers, messages are searched from the 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)) @@ -982,28 +1061,84 @@ NUMBERS is a list of message numbers, messages are searched from the list." (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 @@ -1022,23 +1157,20 @@ NUMBERS is a list of message numbers, messages are searched from the list." 'entire t nil (elmo-file-cache-path cache))) (error "Unplugged"))) - nil (current-buffer) 'unread) (> (buffer-size) 0) (elmo-folder-append-buffer folder - (or flags '(read)) + (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. @@ -1048,7 +1180,6 @@ NUMBERS is a list of message numbers, messages are searched from the list." same-number) (save-excursion (let* ((messages msgs) - (elmo-inhibit-display-retrieval-progress t) (len (length msgs)) succeeds i result) (if (eq dst-folder 'null) @@ -1057,7 +1188,7 @@ NUMBERS is a list of message numbers, messages are searched from the list." (error "move: %d is not writable" (elmo-folder-name-internal dst-folder))) (when messages - ;; src is already opened. + (elmo-folder-open-internal src-folder) (elmo-folder-open-internal dst-folder) (unless (setq succeeds (elmo-folder-append-messages dst-folder src-folder @@ -1068,8 +1199,7 @@ NUMBERS is a list of message numbers, messages are searched from the list." (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)) @@ -1080,7 +1210,7 @@ NUMBERS is a list of message numbers, messages are searched from the list." result) (if no-delete (progn - ;; (message "Copying messages...done") +;;; (message "Copying messages...done") t) (if (eq len 0) (message "No message was moved.") @@ -1093,7 +1223,19 @@ NUMBERS is a list of message numbers, messages are searched from the list." (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.") @@ -1101,11 +1243,20 @@ NUMBERS is a list of message numbers, messages are searched from the list." (luna-define-method elmo-message-cached-p ((folder elmo-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) @@ -1118,14 +1269,18 @@ If CACHED is t, message is set as 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 '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)) + +(luna-define-generic elmo-message-number (folder message-id) + "Get message number from MSGDB which corresponds to MESSAGE-ID.") -(defun elmo-message-entity-set-number (entity number) - (elmo-msgdb-overview-entity-set-number entity number)) +(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. @@ -1161,61 +1316,16 @@ ENTITY is the message-entity to get the parent.") `(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 &optional is-local) "Set message flag. @@ -1230,15 +1340,7 @@ FLAG is a symbol which is one of the following: `read' (remove new and unread flags) If optional IS-LOCAL is non-nil, update only local (not server) status." ;; XXX Transitional implementation. - (case flag - (unread - (elmo-folder-unflag-read folder (list number) is-local)) - (read - (elmo-folder-flag-as-read folder (list number) is-local)) - (answered - (elmo-folder-flag-as-answered folder (list number) is-local)) - (important - (elmo-folder-flag-as-important folder (list number) is-local)))) + (elmo-folder-set-flag folder (list number) flag is-local)) (defun elmo-message-unset-flag (folder number flag &optional is-local) "Unset message flag. @@ -1253,26 +1355,30 @@ FLAG is a symbol which is one of the following: `read' (set unread flag) If optional IS-LOCAL is non-nil, update only local (not server) status." ;; XXX Transitional implementation. - (case flag - (unread - (elmo-folder-flag-as-read folder (list number) is-local)) - (read - (elmo-folder-unflag-read folder (list number) is-local)) - (answered - (elmo-folder-unflag-answered folder (list number) is-local)) - (important - (elmo-folder-unflag-important folder (list number) is-local)))) - -(luna-define-generic elmo-message-field (folder number field) + (elmo-folder-unset-flag folder (list number) flag is-local)) + +(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. @@ -1280,79 +1386,75 @@ FIELD is a symbol of the field.") (luna-define-method elmo-message-folder ((folder elmo-folder) number) folder) ; default is folder -(luna-define-method elmo-folder-unflag-important ((folder elmo-folder) - numbers - &optional is-local) - (when (elmo-folder-msgdb-internal folder) - (dolist (number numbers) - (when (elmo-global-flag-p 'important) - (elmo-global-flag-detach 'important folder number 'remove-if-none)) - (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) - number - 'important)))) - -(luna-define-method elmo-folder-flag-as-important ((folder elmo-folder) - numbers - &optional is-local) - (let (path message-id) - (when (elmo-folder-msgdb-internal folder) - (dolist (number numbers) - ;; important message should always be a read message. - (if (eq (elmo-file-cache-exists-p - (setq message-id - (elmo-message-field folder number 'message-id))) - 'entire) - (elmo-folder-flag-as-read folder (list number))) - (when (elmo-global-flag-p 'important) - (elmo-global-flag-set 'important folder number message-id)) - (elmo-msgdb-set-flag (elmo-folder-msgdb folder) - number - 'important))))) - -(luna-define-method elmo-folder-unflag-read ((folder elmo-folder) - numbers - &optional is-local) - (when (elmo-folder-msgdb-internal folder) - (dolist (number numbers) - (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) - number - 'read)))) - -(luna-define-method elmo-folder-flag-as-read ((folder elmo-folder) - numbers - &optional is-local) - (when (elmo-folder-msgdb-internal folder) - (dolist (number numbers) - (elmo-msgdb-set-flag (elmo-folder-msgdb folder) - number - 'read)))) - -(luna-define-method elmo-folder-unflag-answered ((folder elmo-folder) - numbers - &optional is-local) +(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) - number - 'answered)))) - -(luna-define-method elmo-folder-flag-as-answered ((folder elmo-folder) - numbers - &optional is-local) + (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-set-flag (elmo-folder-msgdb 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." @@ -1371,31 +1473,33 @@ FIELD is a symbol of the field.") ;; Let duplicates be a temporary killed message. (elmo-folder-kill-messages folder duplicates) ;; Should be flag as read. - (elmo-folder-flag-as-read folder duplicates)) + (elmo-folder-unset-flag folder duplicates 'unread)) ((eq (elmo-folder-process-duplicates-internal folder) 'read) ;; Flag as read duplicates. - (elmo-folder-flag-as-read folder 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 @@ -1409,26 +1513,25 @@ FIELD is a symbol of the field.") (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) @@ -1437,54 +1540,83 @@ FIELD is a symbol of the field.") '(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-msgdb-clear (elmo-folder-msgdb folder))) + (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. @@ -1492,53 +1624,57 @@ If optional DISABLE-KILLED is non-nil, killed messages are also synchronized. 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 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))) + 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 @@ -1553,9 +1689,7 @@ If update process is interrupted, return nil.") (setq crossed (elmo-folder-append-msgdb folder new-msgdb)) ;; process crosspost. ;; Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST). - (elmo-folder-process-crosspost folder) - (elmo-folder-set-message-modified folder t) - (elmo-folder-set-flag-modified-internal folder t)) + (elmo-folder-process-crosspost folder)) ;; return value. (or crossed 0))) (quit @@ -1569,7 +1703,14 @@ If update process is interrupted, return nil.") (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.") @@ -1582,7 +1723,8 @@ If update process is interrupted, return nil.") (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)) @@ -1634,8 +1776,8 @@ Return a hashtable for newsgroups." (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) @@ -1654,12 +1796,49 @@ Return a hashtable for 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-global-flag-initialize) - (elmo-dop-queue-load)) + (elmo-dop-queue-load) + (run-hooks 'elmo-init-hook)) (defun elmo-quit () "Quit and cleanup ELMO." @@ -1696,7 +1875,7 @@ Return a hashtable for newsgroups." (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. @@ -1734,6 +1913,15 @@ Return a hashtable for newsgroups." '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 @@ -1741,16 +1929,6 @@ Return a hashtable for newsgroups." (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") -(autoload 'elmo-global-flag-initialize "elmo-flag") -(autoload 'elmo-global-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") - (require 'product) (product-provide (provide 'elmo) (require 'elmo-version))