1 ;;; elmo-map.el --- A ELMO folder class with message number mapping.
3 ;; Copyright (C) 2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; Folders which do not have unique message numbers but unique message names
28 ;; should inherit this folder.
35 (eval-when-compile (require 'cl))
38 ;; location-hash: location->number mapping
39 ;; number-hash: number->location mapping
40 (luna-define-class elmo-map-folder (elmo-folder)
41 (location-alist number-max location-hash))
42 (luna-define-internal-accessors 'elmo-map-folder))
44 (defun elmo-map-folder-numbers-to-locations (folder numbers)
46 (dolist (number numbers)
47 (if (setq pair (elmo-get-hash-val
48 (concat "#" (int-to-string number))
49 (elmo-map-folder-location-hash-internal folder)))
50 (setq locations (cons (cdr pair) locations))))
51 (nreverse locations)))
53 (defun elmo-map-folder-locations-to-numbers (folder locations)
55 (dolist (location locations)
56 (if (setq pair (elmo-get-hash-val
58 (elmo-map-folder-location-hash-internal folder)))
59 (setq numbers (cons (car pair) numbers))))
62 (luna-define-generic elmo-map-folder-list-message-locations (folder)
63 "Return a location list of the FOLDER.")
65 (luna-define-generic elmo-map-folder-set-flag (folder locations flag)
66 "Set FLAG to LOCATIONS.")
68 (luna-define-generic elmo-map-folder-unset-flag (folder locations flag)
69 "Unset FLAG from LOCATIONS.")
71 (luna-define-generic elmo-map-message-fetch (folder location
78 (luna-define-generic elmo-map-folder-delete-messages (folder locations)
81 (luna-define-method elmo-folder-status ((folder elmo-map-folder))
82 (elmo-folder-open-internal folder)
83 (elmo-folder-set-killed-list-internal
85 (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
86 (let ((numbers (mapcar
88 (elmo-map-folder-location-alist-internal folder))))
89 (setq numbers (elmo-living-messages
91 (elmo-folder-killed-list-internal folder)))
93 (cons (elmo-max-of-list numbers)
95 ;; Don't close after status.
96 (unless (elmo-folder-reserve-status-p folder)
97 (elmo-folder-close-internal folder)))))
99 (defun elmo-map-message-number (folder location)
100 "Return number of the message in the FOLDER with LOCATION."
101 (car (elmo-get-hash-val
103 (elmo-map-folder-location-hash-internal folder))))
105 (defun elmo-map-message-location (folder number)
106 "Return location of the message in the FOLDER with NUMBER."
107 (cdr (elmo-get-hash-val
108 (concat "#" (int-to-string number))
109 (elmo-map-folder-location-hash-internal folder))))
111 (luna-define-method elmo-folder-pack-numbers ((folder elmo-map-folder))
112 (let* ((msgdb (elmo-folder-msgdb folder))
114 (sort (elmo-folder-list-messages folder nil
115 (not elmo-pack-number-check-strict))
117 (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
119 total location entity)
120 (setq total (length numbers))
121 (elmo-with-progress-display (> total elmo-display-progress-threshold)
122 (elmo-folder-pack-numbers total "Packing...")
123 (dolist (old-number numbers)
124 (setq entity (elmo-msgdb-message-entity msgdb old-number))
125 (elmo-message-entity-set-number entity number)
126 (elmo-msgdb-append-entity new-msgdb entity
127 (elmo-msgdb-flags msgdb old-number))
130 (elmo-map-message-location folder old-number))
132 (elmo-emit-signal 'message-number-changed folder old-number number)
133 (setq number (1+ number))))
134 (message "Packing...done")
135 (elmo-map-folder-location-setup folder (nreverse location))
136 (elmo-folder-set-msgdb-internal folder new-msgdb)))
138 (defun elmo-map-folder-location-setup (folder locations)
139 (elmo-map-folder-set-location-alist-internal
142 (elmo-map-folder-set-location-hash-internal
143 folder (elmo-make-hash
144 (* 2 (length locations))))
145 (elmo-map-folder-set-number-max-internal folder 0)
146 ;; Set number-max and hashtables.
147 (dolist (location-cons locations)
148 (if (< (elmo-map-folder-number-max-internal folder)
150 (elmo-map-folder-set-number-max-internal folder (car location-cons)))
151 (elmo-set-hash-val (cdr location-cons)
153 (elmo-map-folder-location-hash-internal folder))
154 (elmo-set-hash-val (concat "#" (int-to-string (car location-cons)))
156 (elmo-map-folder-location-hash-internal folder))))
158 (defun elmo-map-folder-update-locations (folder locations)
159 ;; A subroutine to make location-alist.
160 ;; location-alist is existing location-alist.
161 ;; locations is the newest locations.
162 (let ((location-hash (elmo-map-folder-location-hash-internal folder))
163 (exists-hash (elmo-make-hash (length locations)))
164 (number (elmo-map-folder-number-max-internal folder))
166 (dolist (location locations)
167 (if (elmo-get-hash-val location location-hash)
168 (elmo-set-hash-val location t exists-hash)
169 (setq number (1+ number))
170 (let ((pair (cons number location)))
171 (setq new-alist (cons pair new-alist))
172 (elmo-set-hash-val (concat "#" (int-to-string number))
175 (elmo-set-hash-val location pair location-hash))))
176 (elmo-map-folder-set-number-max-internal folder number)
177 (elmo-map-folder-set-location-alist-internal
183 (if (elmo-get-hash-val (cdr pair) exists-hash)
185 (elmo-clear-hash-val (concat "#" (int-to-string (car pair)))
187 (elmo-clear-hash-val (cdr pair) location-hash)
189 (elmo-map-folder-location-alist-internal folder)))
190 (nreverse new-alist)))))
192 (luna-define-method elmo-folder-open-internal ((folder elmo-map-folder))
193 (elmo-map-folder-location-setup
195 (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))
196 (if (elmo-folder-plugged-p folder)
197 (elmo-map-folder-update-locations
199 (elmo-map-folder-list-message-locations folder))))
201 (luna-define-method elmo-folder-commit :after ((folder elmo-map-folder))
202 (when (elmo-folder-persistent-p folder)
203 (elmo-msgdb-location-save (elmo-folder-msgdb-path folder)
204 (elmo-map-folder-location-alist-internal
207 (luna-define-method elmo-folder-close-internal ((folder elmo-map-folder))
208 (elmo-map-folder-set-location-alist-internal folder nil)
209 (elmo-map-folder-set-location-hash-internal folder nil))
211 (luna-define-method elmo-folder-check ((folder elmo-map-folder))
212 (elmo-map-folder-update-locations
214 (elmo-map-folder-list-message-locations folder)))
216 (luna-define-method elmo-folder-next-message-number ((folder elmo-map-folder))
217 (1+ (elmo-map-folder-number-max-internal folder)))
219 (luna-define-method elmo-folder-clear :around ((folder elmo-map-folder)
220 &optional keep-killed)
222 (elmo-map-folder-set-number-max-internal folder 0)
223 (elmo-map-folder-set-location-alist-internal folder nil)
225 (elmo-map-folder-set-location-hash-internal folder (elmo-make-hash)))
226 (luna-call-next-method))
228 (luna-define-method elmo-folder-list-messages-internal
229 ((folder elmo-map-folder) &optional nohide)
230 (mapcar 'car (elmo-map-folder-location-alist-internal folder)))
232 (luna-define-method elmo-folder-set-flag :before ((folder elmo-map-folder)
237 (elmo-map-folder-set-flag
239 (elmo-map-folder-numbers-to-locations folder numbers)
242 (luna-define-method elmo-folder-unset-flag :before ((folder elmo-map-folder)
247 (elmo-map-folder-unset-flag
249 (elmo-map-folder-numbers-to-locations folder numbers)
252 (luna-define-method elmo-message-fetch-internal ((folder elmo-map-folder)
254 &optional section unread)
255 (elmo-map-message-fetch
257 (elmo-map-message-location folder number)
258 strategy section unread))
260 (luna-define-method elmo-folder-list-flagged-internal ((folder elmo-map-folder)
262 (let ((locations (elmo-map-folder-list-flagged folder flag)))
263 (if (listp locations)
264 (elmo-map-folder-locations-to-numbers folder locations)
267 (luna-define-generic elmo-map-folder-list-flagged (folder flag)
268 "Return a list of message location in the FOLDER with FLAG.
269 Return t if the message list is not available.")
271 (luna-define-method elmo-map-folder-list-flagged ((folder elmo-map-folder)
275 (luna-define-method elmo-folder-delete-messages-internal ((folder
278 (elmo-map-folder-delete-messages
280 (elmo-map-folder-numbers-to-locations folder numbers)))
282 (luna-define-method elmo-folder-detach-messages :around ((folder
285 (when (luna-call-next-method)
286 (dolist (number numbers)
287 (elmo-map-folder-set-location-alist-internal
289 (delq (elmo-get-hash-val
290 (concat "#" (int-to-string number))
291 (elmo-map-folder-location-hash-internal
293 (elmo-map-folder-location-alist-internal folder)))
294 (elmo-clear-hash-val (concat "#" (int-to-string number))
295 (elmo-map-folder-location-hash-internal
300 (product-provide (provide 'elmo-map) (require 'elmo-version))
302 ;;; elmo-map.el ends here