X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Fmodb-standard.el;h=108288784482902183a49bc3a9980892ec5465e3;hb=382d7519f582a3d8dc6b524b5bf002510bcc9338;hp=7e15c40d9f8c4a8a46022d2d7ea545ffdc88b463;hpb=eb1bd98710dbe66327aa60465f64e85cadd30c9b;p=elisp%2Fwanderlust.git diff --git a/elmo/modb-standard.el b/elmo/modb-standard.el index 7e15c40..1082887 100644 --- a/elmo/modb-standard.el +++ b/elmo/modb-standard.el @@ -40,12 +40,6 @@ number) :group 'elmo) -(defcustom modb-standard-economize-entity-size nil - "*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.") @@ -61,6 +55,7 @@ When non-nil, redundunt message-id string are not saved." entity-map ; number, msg-id -> entity mapping. flag-map ; number -> flag-list mapping flag-count ; list of (FLAG . COUNT) + overview-handler ; instance of modb-entity-handler. )) (luna-define-internal-accessors 'modb-standard)) @@ -181,59 +176,106 @@ When non-nil, redundunt message-id string are not saved." (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. + ((eq (car-safe ret) 'autoload) + (cdr (cdr ret))) ; message-id. + ((elmo-msgdb-message-entity-field (elmo-message-entity-handler ret) + ret 'message-id)) ; Already loaded. (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)))) - (inhibit-quit t) + (objects (elmo-object-load + (expand-file-name + (modb-standard-entity-filename section) + path))) number msgid) - (dolist (entity (elmo-object-load - (expand-file-name - (modb-standard-entity-filename section) - path))) - (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))) + (cond ((eq (car objects) 'modb-standard-entity-handler) + ;; (standard PARAMETERS ENTITY*) + (let ((handler (apply #'luna-make-entity + (car objects) + (car (cdr objects)))) + entity) + (dolist (element (cdr (cdr objects))) + (setq entity (cons handler (cons nil element)) + number (elmo-msgdb-message-entity-number handler entity) + msgid (modb-standard-loaded-message-id modb number)) + (when msgid + (elmo-msgdb-message-entity-set-field + handler entity 'message-id msgid) + (elmo-set-hash-val (modb-standard-key number) entity table) + (elmo-set-hash-val msgid entity table))))) + (t + ;; legacy format + (dolist (entity objects) + (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 (modb-standard-key number) entity table) + (elmo-set-hash-val msgid entity table))))) (modb-standard-set-entity-map-internal modb table))) (defsubst modb-standard-save-entity-1 (modb path &optional section) (let ((table (modb-standard-entity-map-internal modb)) (filename (expand-file-name - (modb-standard-entity-filename section) path)) + (modb-standard-entity-filename (car section)) path)) + (handler (elmo-msgdb-message-entity-handler modb)) entity entities) - (dolist (number (modb-standard-number-list-internal modb)) - (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)) (setcar entity t))) - (setq entities (cons entity entities)))) + (dolist (number (or (cdr section) + (modb-standard-number-list-internal modb))) + (when (setq entity (elmo-msgdb-message-entity modb number)) + (unless (modb-entity-handler-equal-p + handler + (elmo-message-entity-handler entity)) + (setq entity (elmo-msgdb-copy-message-entity + (elmo-message-entity-handler entity) + entity handler))) + (setq entities (cons (cdr (cdr entity)) entities)))) (if entities - (elmo-object-save filename entities) + (elmo-object-save filename + (nconc + (list (luna-class-name handler) + (modb-entity-handler-dump-parameters handler)) + entities)) (ignore-errors (delete-file filename))))) +(defun modb-standard-cleanup-stale-entities (modb path) + (message "Removing stale entities...") + (let* ((entity-regex + (concat "^" modb-standard-entity-filename "-\\([0-9]+\\)")) + (entities (elmo-uniq-list + (mapcar + (lambda (x) (/ x modb-standard-divide-number)) + (modb-standard-number-list-internal modb)))) + (files (mapcar (lambda(x) + (when (string-match entity-regex x) + (string-to-number (match-string 1 x)))) + (directory-files path nil entity-regex)))) + (dolist (entity (car (elmo-list-diff-nonsortable files entities))) + (ignore-errors (delete-file + (expand-file-name + (modb-standard-entity-filename entity) path)))))) + (defun modb-standard-save-entity (modb path) - (let ((sections (modb-generic-message-modified-internal modb))) - (cond ((listp sections) - (dolist (section sections) - (modb-standard-save-entity-1 modb path section))) - (sections + (let ((modified (modb-generic-message-modified-internal modb))) + (cond ((listp modified) + (let ((sections (mapcar 'list modified)) + section) + (dolist (number (modb-standard-number-list-internal modb)) + (when (setq section (assq (/ number modb-standard-divide-number) + sections)) + (nconc section (list number)))) + (dolist (section sections) + (modb-standard-save-entity-1 modb path section)))) + (modified (modb-standard-save-entity-1 modb path))))) ;;; Implement @@ -249,7 +291,8 @@ When non-nil, redundunt message-id string are not saved." 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) @@ -326,7 +369,7 @@ When non-nil, redundunt message-id string are not saved." 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) @@ -349,10 +392,11 @@ When non-nil, redundunt message-id string are not saved." (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) @@ -451,7 +495,7 @@ When non-nil, redundunt message-id string are not saved." (msg-id (elmo-msgdb-message-entity-field (elmo-message-entity-handler entity) entity 'message-id)) duplicate) - (when msg-id + (when (and number msg-id) ;; number-list (modb-standard-set-number-list-internal msgdb @@ -474,6 +518,15 @@ When non-nil, redundunt message-id string are not saved." (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)) @@ -520,7 +573,8 @@ When non-nil, redundunt message-id string are not saved." (defun modb-standard-message-entity (msgdb key load) (let ((ret (elmo-get-hash-val key - (modb-standard-entity-map-internal msgdb)))) + (modb-standard-entity-map-internal msgdb))) + (inhibit-quit t)) (if (eq 'autoload (car-safe ret)) (when (and load modb-standard-divide-number) (modb-standard-load-entity @@ -541,7 +595,7 @@ When non-nil, redundunt message-id string are not saved." (elmo-message-entity-number ret)))) (luna-define-method elmo-msgdb-message-field ((msgdb modb-standard) - number field) + number field &optional type) (let ((ret (elmo-get-hash-val (modb-standard-key number) (modb-standard-entity-map-internal msgdb)))) @@ -550,7 +604,7 @@ When non-nil, redundunt message-id string are not saved." (cdr (cdr ret)) (elmo-message-entity-field (elmo-msgdb-message-entity msgdb (modb-standard-key number)) - field)))) + field type)))) (luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key) (when key @@ -560,6 +614,14 @@ When non-nil, redundunt message-id string are not saved." ((numberp key) (modb-standard-key key))) 'autoload))) +(luna-define-method elmo-msgdb-message-entity-handler ((msgdb modb-standard)) + (or (modb-standard-overview-handler-internal msgdb) + (modb-standard-set-overview-handler-internal + msgdb + (luna-make-entity 'modb-standard-entity-handler + :mime-charset + (modb-generic-mime-charset-internal msgdb))))) + (require 'product) (product-provide (provide 'modb-standard) (require 'elmo-version))