X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Fmodb-standard.el;h=62fc5b6ed880ce4bf777509fd10cad1d081c42be;hb=e3e6d3218836295f5508b742cacf6c1cc5cacfb4;hp=23d2580d0e787f7d0b79fb29ca319e048a517581;hpb=3ad21e31002618fdd0cdfd1346e78d3302f597e7;p=elisp%2Fwanderlust.git diff --git a/elmo/modb-standard.el b/elmo/modb-standard.el index 23d2580..62fc5b6 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 @@ -56,6 +55,7 @@ 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)) @@ -170,47 +170,113 @@ (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 + ((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))))) - (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-make-hash (elmo-msgdb-length modb)))) + (objects (elmo-object-load + (expand-file-name + (modb-standard-entity-filename section) + path))) + number msgid) + (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)) - entity - table) - (elmo-set-hash-val (elmo-msgdb-message-entity-field - (elmo-message-entity-handler entity) - entity 'message-id) - entity - table)) + 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))) - (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 - (modb-standard-save-entity-1 modb path))))) + (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-cleanup-stale-entities modb path))))) ;;; Implement ;; @@ -225,7 +291,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 +351,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 +369,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 +392,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 +420,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) @@ -411,32 +489,43 @@ (luna-define-method elmo-msgdb-append-entity ((msgdb modb-standard) entity &optional flags) - (let ((number (elmo-msgdb-message-entity-number - (elmo-message-entity-handler entity) entity)) - (msg-id (elmo-msgdb-message-entity-field - (elmo-message-entity-handler entity) entity 'message-id)) - duplicate) - ;; number-list - (modb-standard-set-number-list-internal - msgdb - (nconc (modb-standard-number-list-internal msgdb) - (list number))) - ;; entity-map - (let ((table (modb-standard-entity-map msgdb))) - (setq duplicate (elmo-get-hash-val msg-id table)) - (elmo-set-hash-val (modb-standard-key number) entity table) - (elmo-set-hash-val msg-id entity table)) - ;; modification flags - (modb-standard-set-message-modified msgdb number) - ;; flag-map - (when flags - (elmo-set-hash-val - (modb-standard-key number) - (cons number flags) - (modb-standard-flag-map msgdb)) - (modb-standard-countup-flags msgdb flags) - (modb-standard-set-flag-modified msgdb number)) - duplicate)) + (when entity + (let ((number (elmo-msgdb-message-entity-number + (elmo-message-entity-handler entity) entity)) + (msg-id (elmo-msgdb-message-entity-field + (elmo-message-entity-handler entity) entity 'message-id)) + duplicate) + (when (and number msg-id) + ;; number-list + (modb-standard-set-number-list-internal + msgdb + (nconc (modb-standard-number-list-internal msgdb) + (list number))) + ;; entity-map + (let ((table (modb-standard-entity-map msgdb))) + (setq duplicate (elmo-get-hash-val msg-id table)) + (elmo-set-hash-val (modb-standard-key number) entity table) + (elmo-set-hash-val msg-id entity table)) + ;; modification flags + (modb-standard-set-message-modified msgdb number) + ;; flag-map + (when flags + (elmo-set-hash-val + (modb-standard-key number) + (cons number flags) + (modb-standard-flag-map msgdb)) + (modb-standard-countup-flags msgdb flags) + (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) @@ -447,23 +536,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) @@ -479,24 +570,58 @@ (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 &optional type) + (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 type)))) + +(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))) + +(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))