X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-map.el;h=20c6f65d7cf8974d1c81877e868a1ca4baf4c5b8;hb=2706485848c7fabd109477e1d7fad89a6249f0b2;hp=009f5a283001b35d86bebe50de44a0d1bc9cf73a;hpb=f894e0ccd683e14b47ddbe1422ce24db48159575;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-map.el b/elmo/elmo-map.el index 009f5a2..20c6f65 100644 --- a/elmo/elmo-map.el +++ b/elmo/elmo-map.el @@ -35,30 +35,134 @@ (eval-when-compile (require 'cl)) (eval-and-compile - ;; location-hash: location->number mapping - ;; number-hash: number->location mapping - (luna-define-class elmo-map-folder (elmo-folder) - (location-alist number-max location-hash)) - (luna-define-internal-accessors 'elmo-map-folder)) + (luna-define-class elmo-location-map () + (location-alist location-hash max-number))) + +(defmacro elmo-location-map-alist (entity) + `(luna-slot-value ,entity 'location-alist)) + +(defmacro elmo-location-map-set-alist (entity value) + `(luna-set-slot-value ,entity 'location-alist ,value)) + +(defmacro elmo-location-map-hash (entity) + `(luna-slot-value ,entity 'location-hash)) + +(defmacro elmo-location-map-set-hash (entity value) + `(luna-set-slot-value ,entity 'location-hash ,value)) + +(defmacro elmo-location-map-max-number (entity) + `(luna-slot-value ,entity 'max-number)) + +(defmacro elmo-location-map-set-max-number (entity value) + `(luna-set-slot-value ,entity 'max-number ,value)) + + +(defmacro elmo-location-map-key (number) + `(concat "#" (number-to-string ,number))) + +(defun elmo-location-map-load (location-map directory) + (elmo-location-map-setup + location-map + (elmo-msgdb-location-load directory))) + +(defun elmo-location-map-save (location-map directory) + (let ((alist (elmo-location-map-alist location-map))) + (elmo-msgdb-location-save + directory + (cons (cons (elmo-location-map-max-number location-map) nil) + alist)))) + +(defun elmo-location-map-setup (location-map &optional locations) + "Setup internal data of LOCATION-MAP by LOCATIONS. +Return a location alist." + (let ((hash (elmo-make-hash (length locations))) + (max-number 0)) + ;; Set number-max and hashtables. + (dolist (pair locations) + (setq max-number (max max-number (car pair))) + (when (cdr pair) + (elmo-set-hash-val (cdr pair) pair hash) + (elmo-set-hash-val (elmo-location-map-key (car pair)) pair hash))) + (let ((inhibit-quit t)) + (elmo-location-map-set-max-number location-map max-number) + (elmo-location-map-set-hash location-map hash) + (elmo-location-map-set-alist location-map locations)))) + +(defun elmo-location-map-teardown (location-map) + (elmo-location-map-set-alist location-map nil) + (elmo-location-map-set-hash location-map nil)) + +(defun elmo-location-map-update (location-map locations) + "Update location alist in LOCATION-MAP by LOCATIONS. +Return new location alist." + (let ((old-hash (elmo-location-map-hash location-map)) + (new-hash (elmo-make-hash (length locations))) + (number (elmo-location-map-max-number location-map)) + new-alist) + (setq new-alist + (mapcar + (lambda (location) + (let ((entry (or (elmo-get-hash-val location old-hash) + (cons (setq number (1+ number)) location)))) + (elmo-set-hash-val (elmo-location-map-key (car entry)) + entry + new-hash) + (elmo-set-hash-val location entry new-hash) + entry)) + locations)) + (let ((inhibit-quit t)) + (elmo-location-map-set-max-number location-map number) + (elmo-location-map-set-hash location-map new-hash) + (elmo-location-map-set-alist location-map new-alist)))) + +(defun elmo-location-map-remove-numbers (location-map numbers) + (let ((alist (elmo-location-map-alist location-map)) + (hash (elmo-location-map-hash location-map))) + (dolist (number numbers) + (let* ((key (elmo-location-map-key number)) + (entry (elmo-get-hash-val key hash)) + (inhibit-quit t)) + (elmo-location-map-set-alist + location-map + (setq alist (delq entry alist))) + (elmo-clear-hash-val key hash) + (elmo-clear-hash-val (cdr entry) hash))))) + +(defun elmo-map-message-number (location-map location) + "Return number of the message in the MAPPER with LOCATION." + (car (elmo-get-hash-val + location + (elmo-location-map-hash location-map)))) + +(defun elmo-map-message-location (location-map number) + "Return location of the message in the MAPPER with NUMBER." + (cdr (elmo-get-hash-val + (elmo-location-map-key number) + (elmo-location-map-hash location-map)))) -(defun elmo-map-folder-numbers-to-locations (folder numbers) +(defun elmo-map-numbers-to-locations (location-map numbers) (let (locations pair) (dolist (number numbers) (if (setq pair (elmo-get-hash-val - (concat "#" (int-to-string number)) - (elmo-map-folder-location-hash-internal folder))) + (elmo-location-map-key number) + (elmo-location-map-hash location-map))) (setq locations (cons (cdr pair) locations)))) (nreverse locations))) -(defun elmo-map-folder-locations-to-numbers (folder locations) +(defun elmo-map-locations-to-numbers (location-map locations) (let (numbers pair) (dolist (location locations) (if (setq pair (elmo-get-hash-val location - (elmo-map-folder-location-hash-internal folder))) + (elmo-location-map-hash location-map))) (setq numbers (cons (car pair) numbers)))) (nreverse numbers))) + +(eval-and-compile + (luna-define-class elmo-map-folder (elmo-folder elmo-location-map)) + (luna-define-internal-accessors 'elmo-map-folder)) + (luna-define-generic elmo-map-folder-list-message-locations (folder) "Return a location list of the FOLDER.") @@ -85,7 +189,7 @@ (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))) (let ((numbers (mapcar 'car - (elmo-map-folder-location-alist-internal folder)))) + (elmo-location-map-alist folder)))) (setq numbers (elmo-living-messages numbers (elmo-folder-killed-list-internal folder))) @@ -96,18 +200,6 @@ (unless (elmo-folder-reserve-status-p folder) (elmo-folder-close-internal folder))))) -(defun elmo-map-message-number (folder location) - "Return number of the message in the FOLDER with LOCATION." - (car (elmo-get-hash-val - location - (elmo-map-folder-location-hash-internal folder)))) - -(defun elmo-map-message-location (folder number) - "Return location of the message in the FOLDER with NUMBER." - (cdr (elmo-get-hash-val - (concat "#" (int-to-string number)) - (elmo-map-folder-location-hash-internal folder)))) - (luna-define-method elmo-folder-pack-numbers ((folder elmo-map-folder)) (let* ((msgdb (elmo-folder-msgdb folder)) (numbers @@ -116,10 +208,9 @@ '<)) (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder))) (number 1) - total location entity) - (setq total (length numbers)) - (elmo-with-progress-display (> total elmo-display-progress-threshold) - (elmo-folder-pack-numbers total "Packing...") + location entity) + (elmo-with-progress-display (elmo-folder-pack-numbers (length numbers)) + "Packing" (dolist (old-number numbers) (setq entity (elmo-msgdb-message-entity msgdb old-number)) (elmo-message-entity-set-number entity number) @@ -132,102 +223,43 @@ (elmo-emit-signal 'message-number-changed folder old-number number) (setq number (1+ number)))) (message "Packing...done") - (elmo-map-folder-location-setup folder (nreverse location)) + (elmo-location-map-setup folder (nreverse location)) (elmo-folder-set-msgdb-internal folder new-msgdb))) -(defun elmo-map-folder-location-setup (folder locations) - (elmo-map-folder-set-location-alist-internal - folder - locations) - (elmo-map-folder-set-location-hash-internal - folder (elmo-make-hash - (* 2 (length locations)))) - (elmo-map-folder-set-number-max-internal folder 0) - ;; Set number-max and hashtables. - (dolist (location-cons locations) - (if (< (elmo-map-folder-number-max-internal folder) - (car location-cons)) - (elmo-map-folder-set-number-max-internal folder (car location-cons))) - (elmo-set-hash-val (cdr location-cons) - location-cons - (elmo-map-folder-location-hash-internal folder)) - (elmo-set-hash-val (concat "#" (int-to-string (car location-cons))) - location-cons - (elmo-map-folder-location-hash-internal folder)))) - -(defun elmo-map-folder-update-locations (folder locations) - ;; A subroutine to make location-alist. - ;; location-alist is existing location-alist. - ;; locations is the newest locations. - (let ((location-hash (elmo-map-folder-location-hash-internal folder)) - (exists-hash (elmo-make-hash (length locations))) - (number (elmo-map-folder-number-max-internal folder)) - new-alist) - (dolist (location locations) - (if (elmo-get-hash-val location location-hash) - (elmo-set-hash-val location t exists-hash) - (setq number (1+ number)) - (let ((pair (cons number location))) - (setq new-alist (cons pair new-alist)) - (elmo-set-hash-val (concat "#" (int-to-string number)) - pair - location-hash) - (elmo-set-hash-val location pair location-hash)))) - (elmo-map-folder-set-number-max-internal folder number) - (elmo-map-folder-set-location-alist-internal +(luna-define-method elmo-folder-open-internal ((folder elmo-map-folder)) + (elmo-location-map-load folder (elmo-folder-msgdb-path folder)) + (when (elmo-folder-plugged-p folder) + (elmo-location-map-update folder - (nconc - (delq nil - (mapcar - (lambda (pair) - (if (elmo-get-hash-val (cdr pair) exists-hash) - pair - (elmo-clear-hash-val (concat "#" (int-to-string (car pair))) - location-hash) - (elmo-clear-hash-val (cdr pair) location-hash) - nil)) - (elmo-map-folder-location-alist-internal folder))) - (nreverse new-alist))))) + (elmo-map-folder-list-message-locations folder)))) -(luna-define-method elmo-folder-open-internal ((folder elmo-map-folder)) - (elmo-map-folder-location-setup - folder - (elmo-msgdb-location-load (elmo-folder-msgdb-path folder))) - (if (elmo-folder-plugged-p folder) - (elmo-map-folder-update-locations - folder - (elmo-map-folder-list-message-locations folder)))) +(luna-define-method elmo-folder-open-internal-p ((folder elmo-map-folder)) + (elmo-location-map-alist folder)) (luna-define-method elmo-folder-commit :after ((folder elmo-map-folder)) (when (elmo-folder-persistent-p folder) - (elmo-msgdb-location-save (elmo-folder-msgdb-path folder) - (elmo-map-folder-location-alist-internal - folder)))) + (elmo-location-map-save folder (elmo-folder-msgdb-path folder)))) (luna-define-method elmo-folder-close-internal ((folder elmo-map-folder)) - (elmo-map-folder-set-location-alist-internal folder nil) - (elmo-map-folder-set-location-hash-internal folder nil)) + (elmo-location-map-teardown folder)) (luna-define-method elmo-folder-check ((folder elmo-map-folder)) - (elmo-map-folder-update-locations + (elmo-location-map-update folder (elmo-map-folder-list-message-locations folder))) (luna-define-method elmo-folder-next-message-number ((folder elmo-map-folder)) - (1+ (elmo-map-folder-number-max-internal folder))) + (1+ (elmo-location-map-max-number folder))) (luna-define-method elmo-folder-clear :around ((folder elmo-map-folder) &optional keep-killed) (unless keep-killed - (elmo-map-folder-set-number-max-internal folder 0) - (elmo-map-folder-set-location-alist-internal folder nil) - ;; clear hashtable. - (elmo-map-folder-set-location-hash-internal folder (elmo-make-hash))) + (elmo-location-map-setup folder)) (luna-call-next-method)) (luna-define-method elmo-folder-list-messages-internal ((folder elmo-map-folder) &optional nohide) - (mapcar 'car (elmo-map-folder-location-alist-internal folder))) + (mapcar 'car (elmo-location-map-alist folder))) (luna-define-method elmo-folder-set-flag :before ((folder elmo-map-folder) numbers @@ -236,7 +268,7 @@ (unless is-local (elmo-map-folder-set-flag folder - (elmo-map-folder-numbers-to-locations folder numbers) + (elmo-map-numbers-to-locations folder numbers) flag))) (luna-define-method elmo-folder-unset-flag :before ((folder elmo-map-folder) @@ -246,7 +278,7 @@ (unless is-local (elmo-map-folder-unset-flag folder - (elmo-map-folder-numbers-to-locations folder numbers) + (elmo-map-numbers-to-locations folder numbers) flag))) (luna-define-method elmo-message-fetch-internal ((folder elmo-map-folder) @@ -261,7 +293,7 @@ flag) (let ((locations (elmo-map-folder-list-flagged folder flag))) (if (listp locations) - (elmo-map-folder-locations-to-numbers folder locations) + (elmo-map-locations-to-numbers folder locations) t))) (luna-define-generic elmo-map-folder-list-flagged (folder flag) @@ -277,23 +309,13 @@ Return t if the message list is not available.") numbers) (elmo-map-folder-delete-messages folder - (elmo-map-folder-numbers-to-locations folder numbers))) + (elmo-map-numbers-to-locations folder numbers))) (luna-define-method elmo-folder-detach-messages :around ((folder elmo-map-folder) numbers) (when (luna-call-next-method) - (dolist (number numbers) - (elmo-map-folder-set-location-alist-internal - folder - (delq (elmo-get-hash-val - (concat "#" (int-to-string number)) - (elmo-map-folder-location-hash-internal - folder)) - (elmo-map-folder-location-alist-internal folder))) - (elmo-clear-hash-val (concat "#" (int-to-string number)) - (elmo-map-folder-location-hash-internal - folder))) + (elmo-location-map-remove-numbers folder numbers) t)) ; success (require 'product)