X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo.el;h=bc273b77d199ffd940fe83176613700d0f5ba13a;hb=6444631eeac4bef1933e27202080f62ac536aada;hp=b111675ce764a71e1bb6b5a9e15670a44324b275;hpb=50a175807caa995602ccd01dc65698cdd603f013;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo.el b/elmo/elmo.el index b111675..bc273b7 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)) @@ -59,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 @@ -67,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.") @@ -80,8 +88,22 @@ 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 cache-changed (number) + "Notify the change cache status of the message with NUMBER.") + +(elmo-define-signal update-overview (number) + "Notify update overview of the message with NUMBER.") + ;; autoloads (eval-and-compile + (autoload 'md5 "md5") (autoload 'elmo-dop-queue-flush "elmo-dop") (autoload 'elmo-nntp-post "elmo-nntp") (autoload 'elmo-global-flag-p "elmo-flag") @@ -471,6 +493,19 @@ Return newly created temporary directory name which contains temporary files.") 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)) @@ -489,97 +524,94 @@ NUMBER is a message number to test." (t (memq flag cur-flags))))) -(luna-define-generic elmo-find-fetch-strategy - (folder entity &optional ignore-cache) -;; Returns the message fetching strategy suitable for the message. -;; FOLDER is the ELMO folder structure. -;; ENTITY is the overview entity of the message in the folder. -;; If optional argument IGNORE-CACHE is non-nil, cache is ignored. -;; Returned value is a elmo-fetch-strategy object. -;; If return value is nil, message should not be nil. - ) +(luna-define-generic elmo-find-fetch-strategy (folder number + &optional + ignore-cache + require-entireness) + "Return the message fetching strategy suitable for the message with NUMBER. +FOLDER is the ELMO folder structure. +If optional argument IGNORE-CACHE is non-nil, existing cache is ignored. +If second optional argument REQUIRE-ENTIRENESS is non-nil, +ensure that entireness of the returned strategy is entire. +Returned value is a elmo-fetch-strategy object. +If return value is nil, message should not be nil.") (defmacro elmo-make-fetch-strategy (entireness &optional use-cache save-cache cache-path) -;; Make elmo-message-fetching strategy. -;; ENTIRENESS is 'entire or 'section. -;; 'entire means fetch message entirely at once. -;; 'section means fetch message section by section. -;; If optional USE-CACHE is non-nil, existing cache is used and otherwise, -;; existing cache is thrown away. -;; If SAVE-CACHE is non-nil, fetched message is saved. -;; CACHE-PATH is the cache path to be used as a message cache file. - (` (vector (, entireness) - (, use-cache) (, save-cache) (, cache-path)))) + "Make elmo-message-fetching strategy. +ENTIRENESS is 'entire or 'section. +'entire means fetch message entirely at once. +'section means fetch message section by section. +If optional USE-CACHE is non-nil, existing cache is used and otherwise, +existing cache is thrown away. +If SAVE-CACHE is non-nil, fetched message is saved. +CACHE-PATH is the cache path to be used as a message cache file." + `(vector ,entireness ,use-cache ,save-cache ,cache-path)) (defmacro elmo-fetch-strategy-entireness (strategy) - ;; Return entireness of STRATEGY. - (` (aref (, strategy) 0))) + "Return entireness of STRATEGY." + `(aref ,strategy 0)) (defmacro elmo-fetch-strategy-use-cache (strategy) - ;; Return use-cache of STRATEGY. - (` (aref (, strategy) 1))) + "Return use-cache of STRATEGY." + `(aref ,strategy 1)) (defmacro elmo-fetch-strategy-save-cache (strategy) - ;; Return save-cache of STRATEGY. - (` (aref (, strategy) 2))) + "Return save-cache of STRATEGY." + `(aref ,strategy 2)) (defmacro elmo-fetch-strategy-cache-path (strategy) - ;; Return cache-path of STRATEGY. - (` (aref (, strategy) 3))) - -(luna-define-method elmo-find-fetch-strategy - ((folder elmo-folder) entity &optional ignore-cache) - (let (cache-file size message-id number) - (setq size (elmo-message-entity-field entity 'size)) - (setq message-id (elmo-message-entity-field entity 'message-id)) - (setq number (elmo-message-entity-number entity)) - (setq cache-file (elmo-file-cache-get message-id)) - (setq ignore-cache (or ignore-cache - (null (elmo-message-use-cache-p folder number)))) - (if (or ignore-cache - (null (elmo-file-cache-status cache-file))) - ;; No cache or ignore-cache. - (if (and (not (elmo-folder-local-p folder)) - elmo-message-fetch-threshold - (integerp size) - (>= size elmo-message-fetch-threshold) - (or (not elmo-message-fetch-confirm) - (not (prog1 (y-or-n-p - (format "Fetch entire message(%dbytes)? " - size)) - (message ""))))) - ;; Don't fetch message at all. - nil - ;; Don't use existing cache and fetch entire message at once. - (elmo-make-fetch-strategy - 'entire nil - (elmo-message-use-cache-p folder number) - (elmo-file-cache-path cache-file))) - ;; Cache exists. - (if (not ignore-cache) - (elmo-make-fetch-strategy - 'entire - ;; ...But ignore current section cache and re-fetch - ;; if section cache. - (not (eq (elmo-file-cache-status cache-file) 'section)) - ;; Save cache. - (elmo-message-use-cache-p folder number) - (elmo-file-cache-path cache-file)))))) + "Return cache-path of STRATEGY." + `(aref ,strategy 3)) + +(luna-define-method elmo-find-fetch-strategy ((folder elmo-folder) number + &optional + ignore-cache + require-entireness) + (let ((entity (elmo-message-entity folder number))) + (if (null entity) + (elmo-make-fetch-strategy 'entire) + (let* ((size (elmo-message-entity-field entity 'size)) + (message-id (elmo-message-entity-field entity 'message-id)) + (cache-file (elmo-file-cache-get message-id)) + (use-cache (elmo-message-use-cache-p folder number))) + (if (and (not ignore-cache) + use-cache + (eq (elmo-file-cache-status cache-file) 'entire)) + ;; Cache exists and use it. + (elmo-make-fetch-strategy + 'entire + t ; Use cache. + use-cache ; Save cache. + (elmo-file-cache-path cache-file)) + ;; No cache or ignore-cache. + (if (and (not (elmo-folder-local-p folder)) + (not require-entireness) + elmo-message-fetch-threshold + (integerp size) + (>= size elmo-message-fetch-threshold) + (or (not elmo-message-fetch-confirm) + (not (prog1 + (y-or-n-p + (format "Fetch entire message(%dbytes)? " + size)) + (message ""))))) + ;; Don't fetch message at all. + nil + ;; Don't use existing cache and fetch entire message at once. + (elmo-make-fetch-strategy + 'entire + nil ; Don't use cache. + use-cache ; Save cache. + (elmo-file-cache-path cache-file)))))))) (luna-define-method elmo-folder-list-messages-internal ((folder elmo-folder) &optional visible-only) t) -(defun elmo-folder-encache (folder numbers &optional unread) - "Encache messages in the FOLDER with NUMBERS. -If UNREAD is non-nil, messages are not flaged as read." - (dolist (number numbers) - (elmo-message-encache folder number unread))) - (luna-define-generic elmo-message-encache (folder number &optional read) "Encache message in the FOLDER with NUMBER. If READ is non-nil, message is flaged as read.") @@ -587,15 +619,16 @@ 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) @@ -603,32 +636,15 @@ If READ is non-nil, message is flaged as read.") (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 @@ -708,8 +724,8 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (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-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)))) @@ -821,7 +837,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (and cache t) nil cache-path) - nil (current-buffer) t) + 'unread) (set-buffer-multibyte default-enable-multibyte-characters) (decode-coding-region (point-min) (point-max) elmo-mime-display-as-is-coding-system) @@ -960,7 +976,7 @@ If optional argument IF-EXISTS is nil, load on demand. 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 @@ -1058,18 +1074,11 @@ If optional argument IF-EXISTS is nil, load on demand. 'entire t nil (elmo-file-cache-path cache))) (error "Unplugged"))) - nil (current-buffer) 'unread) (> (buffer-size) 0) (elmo-folder-append-buffer folder - (let ((this-id (elmo-message-field src-folder (car numbers) - 'message-id))) - (and this-id - (string= this-id - (elmo-msgdb-get-message-id-from-buffer)) - (or (elmo-message-flags src-folder (car numbers)) - '(read)))) + (elmo-message-flags-for-append src-folder (car numbers)) (if same-number (car numbers)))))) (error (setq failure t))) ;; FETCH & APPEND finished @@ -1132,7 +1141,19 @@ If optional argument IF-EXISTS is nil, load on demand. (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.") @@ -1145,6 +1166,7 @@ If optional argument IF-EXISTS is nil, load on demand. 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) @@ -1157,7 +1179,8 @@ 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 'cache-changed folder number)) (defun elmo-message-copy-entity (entity) (elmo-msgdb-copy-message-entity (elmo-message-entity-handler entity) @@ -1277,12 +1300,17 @@ VALUE is a value to set.") &optional is-local) (when (elmo-folder-msgdb-internal folder) (dolist (number numbers) - (when (elmo-global-flag-p flag) - (let ((message-id (elmo-message-field folder number 'message-id))) - (elmo-global-flag-set flag folder number message-id))) - (elmo-msgdb-set-flag (elmo-folder-msgdb folder) - number - flag)))) + (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." @@ -1316,11 +1344,16 @@ If Optional LOCAL is non-nil, don't update server flag." &optional is-local) (when (elmo-folder-msgdb-internal folder) (dolist (number numbers) - (when (elmo-global-flag-p flag) - (elmo-global-flag-detach flag folder number 'always)) - (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) - number - flag)))) + (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. @@ -1390,26 +1423,21 @@ If Optional LOCAL is non-nil, don't update server flag." 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) @@ -1418,28 +1446,33 @@ If Optional LOCAL is non-nil, don't update server flag." '(cache entity)) (t '(entity)))) - result err) + result err updated-server-flag) (while (and method-priorities - (null result)) + (not result)) (setq result (case (car method-priorities) (cache (elmo-file-cache-load cache-path section)) (entity - (when (and (condition-case error - (elmo-message-fetch-internal folder number - strategy - section - unread) - (error (setq err error) nil)) - (> (buffer-size) 0)) + (when (condition-case error + (elmo-message-fetch-internal folder number + strategy + section + unread) + (error (setq err error) nil)) + (setq updated-server-flag t) (when (and (elmo-fetch-strategy-save-cache strategy) cache-path) (elmo-file-cache-save cache-path section)) t))) method-priorities (cdr method-priorities))) - (or result - (and err (signal (car err) (cdr err)))))) + (if result + (when (and (not unread) + (elmo-message-flagged-p folder number 'unread)) + (elmo-message-unset-flag folder number 'unread updated-server-flag)) + (when err + (signal (car err) (cdr err)))) + result)) (defun elmo-folder-kill-messages-range (folder beg end) (elmo-folder-set-killed-list-internal @@ -1509,6 +1542,7 @@ If update process is interrupted, return nil.") (elmo-list-diff (elmo-folder-list-messages folder) (elmo-folder-list-messages folder nil 'in-msgdb))) (when diff-new + (setq diff-new (sort diff-new #'<)) (unless disable-killed (setq diff-new (elmo-living-messages diff-new killed-list))) (when mask @@ -1519,7 +1553,7 @@ If update process is interrupted, return nil.") (when (not (eq (length diff-new) (length new-list))) (let* ((diff (elmo-list-diff diff-new new-list)) - (disappeared (car diff))) + (disappeared (sort (car diff) #'<))) (when disappeared (elmo-folder-kill-messages-range folder (car disappeared) @@ -1650,6 +1684,7 @@ Return a hashtable for newsgroups." (elmo-make-directory temp-dir) temp-dir)) +;;; (defun elmo-init () "Initialize ELMO module." (elmo-crosspost-message-alist-load)