X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=elmo%2Felmo-map.el;h=7bd64c7a5d43e085ff525f18ab825f3423344501;hb=fceaa7d966c72630d1b8b146ae0414b4d144a8c6;hp=69ab1c9369eb1a2b41ab3345233bb0b5148128b3;hpb=2a411790da5e15af74e1b82857c221cea02059f7;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-map.el b/elmo/elmo-map.el index 69ab1c9..7bd64c7 100644 --- a/elmo/elmo-map.el +++ b/elmo/elmo-map.el @@ -35,44 +35,142 @@ (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 "#" (int-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))) -(luna-define-generic elmo-map-folder-list-message-locations (folder) - "Return a location list of the FOLDER.") -(luna-define-generic elmo-map-folder-unmark-important (folder locations) - "") +(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-mark-as-important (folder locations) - "") +(luna-define-generic elmo-map-folder-list-message-locations (folder) + "Return a location list of the FOLDER.") -(luna-define-generic elmo-map-folder-unmark-read (folder locations) - "") +(luna-define-generic elmo-map-folder-set-flag (folder locations flag) + "Set FLAG to LOCATIONS.") -(luna-define-generic elmo-map-folder-mark-as-read (folder locations) - "") +(luna-define-generic elmo-map-folder-unset-flag (folder locations flag) + "Unset FLAG from LOCATIONS.") (luna-define-generic elmo-map-message-fetch (folder location strategy @@ -81,15 +179,6 @@ unseen) "") -(luna-define-generic elmo-map-folder-list-unreads (folder) - "") - -(luna-define-generic elmo-map-folder-list-importants (folder) - "") - -(luna-define-method elmo-map-folder-list-importants ((folder elmo-map-folder)) - t) - (luna-define-generic elmo-map-folder-delete-messages (folder locations) "") @@ -100,8 +189,10 @@ (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))) (let ((numbers (mapcar 'car - (elmo-map-folder-location-alist-internal folder)))) - (setq numbers (elmo-living-messages numbers (elmo-folder-killed-list-internal folder))) + (elmo-location-map-alist folder)))) + (setq numbers (elmo-living-messages + numbers + (elmo-folder-killed-list-internal folder))) (prog1 (cons (elmo-max-of-list numbers) (length numbers)) @@ -109,179 +200,83 @@ (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-number ((folder elmo-map-folder)) +(luna-define-method elmo-folder-pack-numbers ((folder elmo-map-folder)) (let* ((msgdb (elmo-folder-msgdb folder)) - (old-number-alist (elmo-msgdb-get-number-alist msgdb)) - (old-overview (elmo-msgdb-get-overview msgdb)) - (old-mark-alist (elmo-msgdb-get-mark-alist msgdb)) - (old-location (elmo-map-folder-location-alist-internal folder)) - old-number overview number-alist mark-alist location - mark (number 1)) - (setq overview old-overview) - (while old-overview - (setq old-number - (elmo-msgdb-overview-entity-get-number (car old-overview))) - (elmo-msgdb-overview-entity-set-number (car old-overview) number) - (setq number-alist - (cons (cons number (cdr (assq old-number old-number-alist))) - number-alist)) - (when (setq mark (cadr (assq old-number old-mark-alist))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist number mark))) - (setq location - (cons (cons number - (elmo-map-message-location folder old-number)) - location)) - (setq number (1+ number)) - (setq old-overview (cdr old-overview))) - (elmo-map-folder-location-setup folder (nreverse location)) - (elmo-folder-set-msgdb-internal - folder - (elmo-make-msgdb overview - (nreverse number-alist) - (nreverse mark-alist))))) - -(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-alist (elmo-map-folder-location-alist-internal folder)) - (locations-in-db (mapcar 'cdr location-alist)) - new-locs new-alist deleted-locs pair i) - (setq new-locs - (elmo-delete-if (function - (lambda (x) (member x locations-in-db))) - locations)) - (setq deleted-locs - (elmo-delete-if (function - (lambda (x) (member x locations))) - locations-in-db)) - (dolist (location deleted-locs) - (setq location-alist - (delq (setq pair - (elmo-get-hash-val - location - (elmo-map-folder-location-hash-internal - folder))) - location-alist)) - (when pair - (elmo-clear-hash-val (concat "#" (int-to-string (car pair))) - (elmo-map-folder-location-hash-internal - folder)) - (elmo-clear-hash-val location - (elmo-map-folder-location-hash-internal - folder)))) - (setq i (elmo-map-folder-number-max-internal folder)) - (dolist (location new-locs) - (setq i (1+ i)) - (elmo-map-folder-set-number-max-internal folder i) - (setq new-alist (cons (setq pair (cons i location)) new-alist)) - (setq new-alist (nreverse new-alist)) - (elmo-set-hash-val (concat "#" (int-to-string i)) - pair - (elmo-map-folder-location-hash-internal - folder)) - (elmo-set-hash-val location - pair - (elmo-map-folder-location-hash-internal - folder))) - (setq location-alist - (sort (nconc location-alist new-alist) - (lambda (x y) (< (car x) (car y))))) - (elmo-map-folder-set-location-alist-internal folder location-alist))) + (numbers + (sort (elmo-folder-list-messages folder nil + (not elmo-pack-number-check-strict)) + '<)) + (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder))) + (number 1) + 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) + (elmo-msgdb-append-entity new-msgdb entity + (elmo-msgdb-flags msgdb old-number)) + (setq location + (cons (cons number + (elmo-map-message-location folder old-number)) + location)) + (elmo-emit-signal 'message-number-changed folder old-number number) + (setq number (1+ number)))) + (message "Packing...done") + (elmo-location-map-setup folder (nreverse location)) + (elmo-folder-set-msgdb-internal folder new-msgdb))) (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)))) + (elmo-location-map-load folder (elmo-folder-msgdb-path folder)) + (when (elmo-folder-plugged-p folder) + (elmo-location-map-update + folder + (elmo-map-folder-list-message-locations 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-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))) - -(luna-define-method elmo-folder-unmark-important ((folder elmo-map-folder) - numbers) - (elmo-map-folder-unmark-important - folder - (elmo-map-folder-numbers-to-locations folder numbers))) - -(luna-define-method elmo-folder-mark-as-important ((folder elmo-map-folder) - numbers) - (elmo-map-folder-mark-as-important - folder - (elmo-map-folder-numbers-to-locations folder numbers))) - -(luna-define-method elmo-folder-unmark-read ((folder elmo-map-folder) - numbers) - (elmo-map-folder-unmark-read - folder - (elmo-map-folder-numbers-to-locations folder numbers))) - -(luna-define-method elmo-folder-mark-as-read ((folder elmo-map-folder) numbers) - (elmo-map-folder-mark-as-read - folder - (elmo-map-folder-numbers-to-locations folder numbers))) + (mapcar 'car (elmo-location-map-alist folder))) + +(luna-define-method elmo-folder-set-flag :before ((folder elmo-map-folder) + numbers + flag + &optional is-local) + (unless is-local + (elmo-map-folder-set-flag + folder + (elmo-map-numbers-to-locations folder numbers) + flag))) + +(luna-define-method elmo-folder-unset-flag :before ((folder elmo-map-folder) + numbers + flag + &optional is-local) + (unless is-local + (elmo-map-folder-unset-flag + folder + (elmo-map-numbers-to-locations folder numbers) + flag))) (luna-define-method elmo-message-fetch-internal ((folder elmo-map-folder) number strategy @@ -291,36 +286,34 @@ (elmo-map-message-location folder number) strategy section unread)) -(luna-define-method elmo-folder-list-unreads ((folder elmo-map-folder)) - (let ((locations (elmo-map-folder-list-unreads folder))) +(luna-define-method elmo-folder-list-flagged-internal ((folder elmo-map-folder) + flag) + (let ((locations (elmo-map-folder-list-flagged folder flag))) (if (listp locations) - (elmo-map-folder-locations-to-numbers - folder - (elmo-map-folder-list-unreads folder))))) + (elmo-map-locations-to-numbers folder locations) + t))) -(luna-define-method elmo-folder-list-importants ((folder elmo-map-folder)) - (let ((locations (elmo-map-folder-list-importants folder))) - (if (listp locations) - (elmo-uniq-list - (nconc (elmo-map-folder-locations-to-numbers folder locations) - (elmo-folder-list-messages-with-global-mark - folder elmo-msgdb-important-mark))) - (luna-call-next-method)))) - -(luna-define-method elmo-folder-delete-messages ((folder elmo-map-folder) - numbers) +(luna-define-generic elmo-map-folder-list-flagged (folder flag) + "Return a list of message location in the FOLDER with FLAG. +Return t if the message list is not available.") + +(luna-define-method elmo-map-folder-list-flagged ((folder elmo-map-folder) + flag) + t) + +(luna-define-method elmo-folder-delete-messages-internal ((folder + elmo-map-folder) + numbers) (elmo-map-folder-delete-messages folder - (elmo-map-folder-numbers-to-locations folder numbers)) - (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)))) - t) ; success + (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) + (elmo-location-map-remove-numbers folder numbers) + t)) ; success (require 'product) (product-provide (provide 'elmo-map) (require 'elmo-version))