(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-folder-numbers-to-locations (folder numbers)
+(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-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-unflag-important (folder locations)
- "")
-
-(luna-define-generic elmo-map-folder-flag-as-important (folder locations)
- "")
-
-(luna-define-generic elmo-map-folder-unflag-read (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-flag-as-read (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-unflag-answered (folder locations)
- "")
+(luna-define-generic elmo-map-folder-set-flag (folder locations flag)
+ "Set FLAG to LOCATIONS.")
-(luna-define-generic elmo-map-folder-flag-as-answered (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
unseen)
"")
-(luna-define-generic elmo-map-folder-list-unreads (folder)
- "")
-
-(luna-define-method elmo-map-folder-list-unreads ((folder elmo-map-folder))
- t)
-
-(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-list-answereds (folder)
- "")
-
-(luna-define-method elmo-map-folder-list-answereds ((folder elmo-map-folder))
- t)
-
(luna-define-generic elmo-map-folder-delete-messages (folder locations)
"")
(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))
(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 (sort (elmo-folder-list-messages folder nil 'in-msgdb) '<))
+ (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)
- 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-msgdb-overview-entity-set-number entity 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-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-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)))
-
(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-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-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-unflag-important :before ((folder
- elmo-map-folder)
- numbers
- &optional
- is-local)
- (unless is-local
- (elmo-map-folder-unflag-important
- folder
- (elmo-map-folder-numbers-to-locations folder numbers))))
-
-(luna-define-method elmo-folder-flag-as-important :before ((folder
- elmo-map-folder)
- numbers
- &optional
- is-local)
- (unless is-local
- (elmo-map-folder-flag-as-important
- folder
- (elmo-map-folder-numbers-to-locations folder numbers))))
+ (mapcar 'car (elmo-location-map-alist folder)))
-(luna-define-method elmo-folder-unflag-read :before ((folder elmo-map-folder)
- numbers
- &optional is-local)
+(luna-define-method elmo-folder-set-flag :before ((folder elmo-map-folder)
+ numbers
+ flag
+ &optional is-local)
(unless is-local
- (elmo-map-folder-unflag-read
+ (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-flag-as-read :before ((folder
- elmo-map-folder)
- numbers
- &optional is-local)
+(luna-define-method elmo-folder-unset-flag :before ((folder elmo-map-folder)
+ numbers
+ flag
+ &optional is-local)
(unless is-local
- (elmo-map-folder-flag-as-read
+ (elmo-map-folder-unset-flag
folder
- (elmo-map-folder-numbers-to-locations folder numbers))))
-
-(luna-define-method elmo-folder-unflag-answered :before ((folder
- elmo-map-folder)
- numbers)
- (elmo-map-folder-unflag-answered
- folder
- (elmo-map-folder-numbers-to-locations folder numbers)))
-
-(luna-define-method elmo-folder-flag-as-answered :before ((folder
- elmo-map-folder)
- numbers)
- (elmo-map-folder-flag-as-answered
- 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)
number strategy
(elmo-map-message-location folder number)
strategy section unread))
-(luna-define-method elmo-folder-list-unreads :around ((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 locations)
- (luna-call-next-method))))
+ (elmo-map-locations-to-numbers folder locations)
+ t)))
-(luna-define-method elmo-folder-list-importants :around ((folder
- elmo-map-folder))
- (let ((locations (elmo-map-folder-list-importants folder)))
- (if (listp locations)
- (elmo-map-folder-locations-to-numbers folder locations)
- (luna-call-next-method))))
+(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-folder-list-answereds :around ((folder
- elmo-map-folder))
- (let ((locations (elmo-map-folder-list-answereds folder)))
- (if (listp locations)
- (elmo-map-folder-locations-to-numbers folder locations)
- (luna-call-next-method))))
+(luna-define-method elmo-map-folder-list-flagged ((folder elmo-map-folder)
+ flag)
+ t)
-(luna-define-method elmo-folder-delete-messages ((folder elmo-map-folder)
- numbers)
+(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))
projects / elisp / wanderlust.git / blobdiff