X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Fmodb-standard.el;h=46e4b6179157d155be6439e192e1277df84f985d;hb=6444631eeac4bef1933e27202080f62ac536aada;hp=5a60da4fa5f95255600d38fa9f093d0f07af3d0e;hpb=aa096c0b3f2730fa251fc38d8b3143dde8ab26b4;p=elisp%2Fwanderlust.git diff --git a/elmo/modb-standard.el b/elmo/modb-standard.el index 5a60da4..46e4b61 100644 --- a/elmo/modb-standard.el +++ b/elmo/modb-standard.el @@ -32,7 +32,6 @@ (eval-when-compile (require 'cl)) (require 'elmo-util) -(require 'mime) (require 'modb) (defcustom modb-standard-divide-number 500 @@ -41,6 +40,12 @@ number) :group 'elmo) +(defcustom modb-standard-economize-entity-size t + "*Economize message entity size. +When non-nil, redundunt message-id string are not saved." + :type 'boolean + :group 'elmo) + (defvar modb-standard-entity-filename "entity" "Message entity database.") @@ -170,24 +175,40 @@ (number-to-string section)) modb-standard-entity-filename)) +(defsubst modb-standard-loaded-message-id (msgdb number) + "Get message-id for autoloaded entity." + (let ((ret (elmo-get-hash-val + (modb-standard-key number) + (modb-standard-entity-map-internal msgdb)))) + (cond + ((and ret (eq (car-safe ret) 'autoload)) + (cdr (cdr ret))) ; message-id. + ((and ret (stringp (car-safe ret))) + ;; Already loaded. + (car ret)) + ((null ret) + ;; Garbage entity. + (elmo-clear-hash-val (modb-standard-key number) + (modb-standard-entity-map-internal msgdb)) + nil) ; return nil. + (t (error "Internal error: invalid msgdb status"))))) + (defun modb-standard-load-entity (modb path &optional section) (let ((table (or (modb-standard-entity-map-internal modb) - (elmo-make-hash (elmo-msgdb-length modb))))) + (elmo-make-hash (elmo-msgdb-length modb)))) + number msgid) (dolist (entity (elmo-object-load (expand-file-name (modb-standard-entity-filename section) path))) - (elmo-set-hash-val (modb-standard-key - (elmo-msgdb-message-entity-number - (elmo-message-entity-handler entity) - entity)) - entity - table) - (elmo-set-hash-val (elmo-msgdb-message-entity-field - (elmo-message-entity-handler entity) - entity 'message-id) - entity - table)) + (setq number (elmo-msgdb-message-entity-number + (elmo-message-entity-handler entity) + entity) + msgid (modb-standard-loaded-message-id modb number)) + (when msgid + (setcar entity msgid) + (elmo-set-hash-val msgid entity table) + (elmo-set-hash-val (modb-standard-key number) entity table))) (modb-standard-set-entity-map-internal modb table))) (defsubst modb-standard-save-entity-1 (modb path &optional section) @@ -199,6 +220,9 @@ (when (and (or (null section) (= section (/ number modb-standard-divide-number))) (setq entity (elmo-msgdb-message-entity modb number))) + (when modb-standard-economize-entity-size + (when (stringp (car entity)) + (setq entity (cons t (cdr entity))))) (setq entities (cons entity entities)))) (if entities (elmo-object-save filename entities) @@ -225,7 +249,8 @@ t))) (luna-define-method elmo-msgdb-save ((msgdb modb-standard)) - (let ((path (elmo-msgdb-location msgdb))) + (let ((path (elmo-msgdb-location msgdb)) + (inhibit-quit t)) (when (elmo-msgdb-message-modified-p msgdb) (modb-standard-save-msgid msgdb path) (modb-standard-save-entity msgdb path) @@ -284,6 +309,9 @@ (luna-define-method elmo-msgdb-length ((msgdb modb-standard)) (length (modb-standard-number-list-internal msgdb))) +(luna-define-method elmo-msgdb-flag-available-p ((msgdb modb-standard) flag) + t) + (luna-define-method elmo-msgdb-flags ((msgdb modb-standard) number) (modb-standard-message-flags msgdb number)) @@ -299,7 +327,7 @@ new-flags diff) (unless (memq flag cur-flags) (setq new-flags (cons flag cur-flags)) - (setq diff (elmo-list-diff new-flags cur-flags)) + (setq diff (elmo-list-diff-nonsortable new-flags cur-flags)) (modb-standard-countup-flags msgdb (car diff)) (modb-standard-countup-flags msgdb (cadr diff) -1) (elmo-set-hash-val (modb-standard-key number) @@ -322,10 +350,11 @@ (modb-standard-flag-map msgdb))) (t (let ((cur-flags (modb-standard-message-flags msgdb number)) + (inhibit-quit t) new-flags diff) (when (memq flag cur-flags) (setq new-flags (delq flag (copy-sequence cur-flags))) - (setq diff (elmo-list-diff new-flags cur-flags)) + (setq diff (elmo-list-diff-nonsortable new-flags cur-flags)) (modb-standard-countup-flags msgdb (car diff)) (modb-standard-countup-flags msgdb (cadr diff) -1) (elmo-set-hash-val (modb-standard-key number) @@ -349,22 +378,29 @@ (dolist (number (modb-standard-number-list-internal msgdb)) (unless (memq 'unread (modb-standard-message-flags msgdb number)) (setq matched (cons number matched))))) - (digest - (mapatoms - (lambda (atom) - (setq entry (symbol-value atom)) - (when (modb-standard-match-flags '(unread important) - (cdr entry)) - (setq matched (cons (car entry) matched)))) - (modb-standard-flag-map msgdb))) + (uncached + (dolist (number (modb-standard-number-list-internal msgdb)) + (unless (memq 'cached (modb-standard-message-flags msgdb number)) + (setq matched (cons number matched))))) (any (mapatoms (lambda (atom) (setq entry (symbol-value atom)) - (when (modb-standard-match-flags '(unread important answered) - (cdr entry)) + (unless (and (eq (length (cdr entry)) 1) + (eq (car (cdr entry)) 'cached)) + ;; If there is a flag other than cached, then the message + ;; matches to `any'. (setq matched (cons (car entry) matched)))) (modb-standard-flag-map msgdb))) + (digest + (let ((flags (append elmo-digest-flags + (elmo-get-global-flags t t)))) + (mapatoms + (lambda (atom) + (setq entry (symbol-value atom)) + (when (modb-standard-match-flags flags (cdr entry)) + (setq matched (cons (car entry) matched)))) + (modb-standard-flag-map msgdb)))) (t (mapatoms (lambda (atom) @@ -440,6 +476,15 @@ (modb-standard-set-flag-modified msgdb number)) duplicate)))) +(luna-define-method elmo-msgdb-update-entity ((msgdb modb-standard) + entity values) + (let ((handler (elmo-message-entity-handler entity))) + (when (elmo-msgdb-message-entity-update-fields handler entity values) + (modb-standard-set-message-modified + msgdb + (elmo-msgdb-message-entity-number handler entity)) + t))) + (luna-define-method elmo-msgdb-delete-messages ((msgdb modb-standard) numbers) (let ((number-list (modb-standard-number-list-internal msgdb)) @@ -449,23 +494,25 @@ (dolist (number numbers) (setq key (modb-standard-key number) entity (elmo-get-hash-val key entity-map)) - ;; number-list - (setq number-list (delq number number-list)) - ;; entity-map - (elmo-clear-hash-val key entity-map) - (elmo-clear-hash-val (modb-standard-entity-id entity) entity-map) - ;; flag-count (must be BEFORE flag-map) - (modb-standard-countup-flags - msgdb - (modb-standard-message-flags msgdb number) - -1) - ;; flag-map - (elmo-clear-hash-val key flag-map) - (modb-standard-set-message-modified msgdb number) - (modb-standard-set-flag-modified msgdb number)) + (when entity + ;; number-list + (setq number-list (delq number number-list)) + ;; entity-map + (elmo-clear-hash-val key entity-map) + (elmo-clear-hash-val (modb-standard-entity-id entity) entity-map) + ;; flag-count (must be BEFORE flag-map) + (modb-standard-countup-flags + msgdb + (modb-standard-message-flags msgdb number) + -1) + ;; flag-map + (elmo-clear-hash-val key flag-map) + (modb-standard-set-message-modified msgdb number) + (modb-standard-set-flag-modified msgdb number))) (modb-standard-set-number-list-internal msgdb number-list) (modb-standard-set-entity-map-internal msgdb entity-map) - (modb-standard-set-flag-map-internal msgdb flag-map))) + (modb-standard-set-flag-map-internal msgdb flag-map) + t)) (luna-define-method elmo-msgdb-sort-entities ((msgdb modb-standard) predicate &optional app-data) @@ -481,24 +528,50 @@ (message "Sorting...done") msgdb)) -(luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key) - (let ((ret (and key - (elmo-get-hash-val - (cond ((stringp key) key) - ((numberp key) (modb-standard-key key))) - (modb-standard-entity-map-internal msgdb))))) +(defun modb-standard-message-entity (msgdb key load) + (let ((ret (elmo-get-hash-val + key + (modb-standard-entity-map-internal msgdb))) + (inhibit-quit t)) (if (eq 'autoload (car-safe ret)) - (when modb-standard-divide-number + (when (and load modb-standard-divide-number) (modb-standard-load-entity msgdb (elmo-msgdb-location msgdb) (/ (nth 1 ret) modb-standard-divide-number)) - (elmo-get-hash-val - (cond ((stringp key) key) - ((numberp key) (modb-standard-key key))) - (modb-standard-entity-map-internal msgdb))) + (modb-standard-message-entity msgdb key nil)) ret))) +(luna-define-method elmo-msgdb-message-number ((msgdb modb-standard) + message-id) + (let ((ret (elmo-get-hash-val + message-id + (modb-standard-entity-map-internal msgdb)))) + (if (eq 'autoload (car-safe ret)) + ;; Not loaded yet but can return number. + (nth 1 ret) + (elmo-message-entity-number ret)))) + +(luna-define-method elmo-msgdb-message-field ((msgdb modb-standard) + number field) + (let ((ret (elmo-get-hash-val + (modb-standard-key number) + (modb-standard-entity-map-internal msgdb)))) + (if (and (eq 'autoload (car-safe ret)) (eq field 'message-id)) + ;; Not loaded yet but can return message-id + (cdr (cdr ret)) + (elmo-message-entity-field (elmo-msgdb-message-entity + msgdb (modb-standard-key number)) + field)))) + +(luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key) + (when key + (modb-standard-message-entity + msgdb + (cond ((stringp key) key) + ((numberp key) (modb-standard-key key))) + 'autoload))) + (require 'product) (product-provide (provide 'modb-standard) (require 'elmo-version))