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-unmark-important (folder locations)
68 (luna-define-generic elmo-map-folder-mark-as-important (folder locations)
71 (luna-define-generic elmo-map-folder-unmark-read (folder locations)
74 (luna-define-generic elmo-map-folder-mark-as-read (folder locations)
77 (luna-define-generic elmo-map-message-fetch (folder location
84 (luna-define-generic elmo-map-folder-list-unreads (folder)
87 (luna-define-generic elmo-map-folder-list-importants (folder)
90 (luna-define-method elmo-map-folder-list-importants ((folder elmo-map-folder))
93 (luna-define-generic elmo-map-folder-delete-messages (folder locations)
96 (luna-define-method elmo-folder-status ((folder elmo-map-folder))
97 (elmo-folder-open-internal folder)
99 (let ((numbers (mapcar
101 (elmo-map-folder-location-alist-internal folder))))
102 (cons (elmo-max-of-list numbers)
105 (elmo-folder-close-internal folder)))
107 (defun elmo-map-message-number (folder location)
108 "Return number of the message in the FOLDER with LOCATION."
109 (car (elmo-get-hash-val
111 (elmo-map-folder-location-hash-internal folder))))
113 (defun elmo-map-message-location (folder number)
114 "Return location of the message in the FOLDER with NUMBER."
115 (cdr (elmo-get-hash-val
116 (concat "#" (int-to-string number))
117 (elmo-map-folder-location-hash-internal folder))))
119 (luna-define-method elmo-folder-pack-number ((folder elmo-map-folder))
120 (let* ((msgdb (elmo-folder-msgdb folder))
121 (old-number-alist (elmo-msgdb-get-number-alist msgdb))
122 (old-overview (elmo-msgdb-get-overview msgdb))
123 (old-mark-alist (elmo-msgdb-get-mark-alist msgdb))
124 (old-location (elmo-map-folder-location-alist-internal folder))
125 old-number overview number-alist mark-alist location
127 (setq overview old-overview)
130 (elmo-msgdb-overview-entity-get-number (car old-overview)))
131 (elmo-msgdb-overview-entity-set-number (car old-overview) number)
133 (cons (cons number (cdr (assq old-number old-number-alist)))
135 (when (setq mark (cadr (assq old-number old-mark-alist)))
137 (elmo-msgdb-mark-append
138 mark-alist number mark)))
141 (elmo-map-message-location folder old-number))
143 (setq number (1+ number))
144 (setq old-overview (cdr old-overview)))
145 (elmo-map-folder-location-setup folder (nreverse location))
146 (elmo-folder-set-msgdb-internal
149 (nreverse number-alist)
150 (nreverse mark-alist)
151 (elmo-msgdb-make-overview-hashtb overview)))))
153 (defun elmo-map-folder-location-setup (folder locations)
154 (elmo-map-folder-set-location-alist-internal
157 (elmo-map-folder-set-location-hash-internal
158 folder (elmo-make-hash
159 (* 2 (length locations))))
160 (elmo-map-folder-set-number-max-internal folder 0)
161 ;; Set number-max and hashtables.
162 (dolist (location-cons locations)
163 (if (< (elmo-map-folder-number-max-internal folder)
165 (elmo-map-folder-set-number-max-internal folder (car location-cons)))
166 (elmo-set-hash-val (cdr location-cons)
168 (elmo-map-folder-location-hash-internal folder))
169 (elmo-set-hash-val (concat "#" (int-to-string (car location-cons)))
171 (elmo-map-folder-location-hash-internal folder))))
173 (defun elmo-map-folder-update-locations (folder locations)
174 ;; A subroutine to make location-alist.
175 ;; location-alist is existing location-alist.
176 ;; locations is the newest locations.
177 (let* ((location-alist (elmo-map-folder-location-alist-internal folder))
178 (locations-in-db (mapcar 'cdr location-alist))
179 new-locs new-alist deleted-locs pair i)
181 (elmo-delete-if (function
182 (lambda (x) (member x locations-in-db)))
185 (elmo-delete-if (function
186 (lambda (x) (member x locations)))
188 (dolist (location deleted-locs)
193 (elmo-map-folder-location-hash-internal
197 (elmo-clear-hash-val (concat "#" (int-to-string (car pair)))
198 (elmo-map-folder-location-hash-internal
200 (elmo-clear-hash-val location
201 (elmo-map-folder-location-hash-internal
203 (setq i (elmo-map-folder-number-max-internal folder))
204 (dolist (location new-locs)
206 (elmo-map-folder-set-number-max-internal folder i)
207 (setq new-alist (cons (setq pair (cons i location)) new-alist))
208 (setq new-alist (nreverse new-alist))
209 (elmo-set-hash-val (concat "#" (int-to-string i))
211 (elmo-map-folder-location-hash-internal
213 (elmo-set-hash-val location
215 (elmo-map-folder-location-hash-internal
218 (sort (nconc location-alist new-alist)
219 (lambda (x y) (< (car x) (car y)))))
220 (elmo-map-folder-set-location-alist-internal folder location-alist)))
222 (luna-define-method elmo-folder-open-internal ((folder elmo-map-folder))
223 (elmo-map-folder-location-setup
225 (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))
226 (if (elmo-folder-plugged-p folder)
227 (elmo-map-folder-update-locations
229 (elmo-map-folder-list-message-locations folder))))
231 (luna-define-method elmo-folder-commit :after ((folder elmo-map-folder))
232 (when (elmo-folder-persistent-p folder)
233 (elmo-msgdb-location-save (elmo-folder-msgdb-path folder)
234 (elmo-map-folder-location-alist-internal
237 (luna-define-method elmo-folder-close-internal ((folder elmo-map-folder))
238 (elmo-map-folder-set-location-alist-internal folder nil)
239 (elmo-map-folder-set-location-hash-internal folder nil))
241 (luna-define-method elmo-folder-check ((folder elmo-map-folder))
242 (elmo-map-folder-update-locations
244 (elmo-map-folder-list-message-locations folder)))
246 (luna-define-method elmo-folder-list-messages-internal
247 ((folder elmo-map-folder) &optional nohide)
248 (mapcar 'car (elmo-map-folder-location-alist-internal folder)))
250 (luna-define-method elmo-folder-unmark-important ((folder elmo-map-folder)
252 (elmo-map-folder-unmark-important
254 (elmo-map-folder-numbers-to-locations folder numbers)))
256 (luna-define-method elmo-folder-mark-as-important ((folder elmo-map-folder)
258 (elmo-map-folder-mark-as-important
260 (elmo-map-folder-numbers-to-locations folder numbers)))
262 (luna-define-method elmo-folder-unmark-read ((folder elmo-map-folder)
264 (elmo-map-folder-unmark-read
266 (elmo-map-folder-numbers-to-locations folder numbers)))
268 (luna-define-method elmo-folder-mark-as-read ((folder elmo-map-folder) numbers)
269 (elmo-map-folder-mark-as-read
271 (elmo-map-folder-numbers-to-locations folder numbers)))
273 (luna-define-method elmo-message-fetch-internal ((folder elmo-map-folder)
275 &optional section unread)
276 (elmo-map-message-fetch
278 (elmo-map-message-location folder number)
279 strategy section unread))
281 (luna-define-method elmo-folder-list-unreads-internal
282 ((folder elmo-map-folder) unread-marks &optional mark-alist)
283 (elmo-map-folder-locations-to-numbers
285 (elmo-map-folder-list-unreads folder)))
287 (luna-define-method elmo-folder-list-importants-internal
288 ((folder elmo-map-folder) important-mark)
289 (let ((locations (elmo-map-folder-list-importants folder)))
290 (if (listp locations)
291 (elmo-map-folder-locations-to-numbers folder locations)
294 (luna-define-method elmo-folder-delete-messages ((folder elmo-map-folder)
296 (elmo-map-folder-delete-messages
298 (elmo-map-folder-numbers-to-locations folder numbers))
299 (dolist (number numbers)
300 (elmo-map-folder-set-location-alist-internal
302 (delq (elmo-get-hash-val
303 (concat "#" (int-to-string number))
304 (elmo-map-folder-location-hash-internal
306 (elmo-map-folder-location-alist-internal folder))))
311 (product-provide (provide 'elmo-map) (require 'elmo-version))
313 ;;; elmo-map.el ends here