* elmo-dop.el (elmo-folder-status-dop): If spool-folder is absent,
[elisp/wanderlust.git] / elmo / elmo-map.el
1 ;;; elmo-map.el --- A ELMO folder class with message number mapping.
2
3 ;; Copyright (C) 2000 Yuuichi Teranishi <teranisi@gohome.org>
4
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
7
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
9
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)
13 ;; any later version.
14 ;;
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.
19 ;;
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.
24 ;;
25
26 ;;; Commentary:
27 ;; Folders which do not have unique message numbers but unique message names
28 ;; should inherit this folder.
29
30 ;;; Code:
31 ;;
32 (require 'elmo)
33 (require 'elmo-msgdb)
34
35 (eval-when-compile (require 'cl))
36
37 (eval-and-compile
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))
43
44 (defun elmo-map-folder-numbers-to-locations (folder numbers)
45   (let (locations pair)
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)))
52
53 (defun elmo-map-folder-locations-to-numbers (folder locations)
54   (let (numbers pair)
55     (dolist (location locations)
56       (if (setq pair (elmo-get-hash-val
57                       location
58                       (elmo-map-folder-location-hash-internal folder)))
59           (setq numbers (cons (car pair) numbers))))
60     (nreverse numbers)))
61
62 (luna-define-generic elmo-map-folder-list-message-locations (folder)
63   "Return a location list of the FOLDER.")
64
65 (luna-define-generic elmo-map-folder-unmark-important (folder locations)
66   "")
67
68 (luna-define-generic elmo-map-folder-mark-as-important (folder locations)
69   "")
70
71 (luna-define-generic elmo-map-folder-unmark-read (folder locations)
72   "")
73
74 (luna-define-generic elmo-map-folder-mark-as-read (folder locations)
75   "")
76
77 (luna-define-generic elmo-map-message-fetch (folder location
78                                                     strategy
79                                                     &optional
80                                                     section
81                                                     unseen)
82   "")
83
84 (luna-define-generic elmo-map-folder-list-unreads (folder)
85   "")
86
87 (luna-define-generic elmo-map-folder-list-importants (folder)
88   "")
89
90 (luna-define-method elmo-map-folder-list-importants ((folder elmo-map-folder))
91   t)
92
93 (luna-define-generic elmo-map-folder-delete-messages (folder locations)
94   "")
95
96 (luna-define-method elmo-folder-status ((folder elmo-map-folder))
97   (elmo-folder-open-internal folder)
98   (elmo-folder-set-killed-list-internal
99    folder
100    (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
101   (let ((numbers (mapcar
102                   'car
103                   (elmo-map-folder-location-alist-internal folder))))
104     (setq numbers (elmo-living-messages numbers (elmo-folder-killed-list-internal folder)))
105     (prog1
106         (cons (elmo-max-of-list numbers)
107               (length numbers))
108       ;; Don't close after status.
109       (unless (elmo-folder-reserve-status-p folder)
110         (elmo-folder-close-internal folder)))))
111
112 (defun elmo-map-message-number (folder location)
113   "Return number of the message in the FOLDER with LOCATION."
114   (car (elmo-get-hash-val
115         location
116         (elmo-map-folder-location-hash-internal folder))))
117
118 (defun elmo-map-message-location (folder number)
119   "Return location of the message in the FOLDER with NUMBER."
120   (cdr (elmo-get-hash-val
121         (concat "#" (int-to-string number))
122         (elmo-map-folder-location-hash-internal folder))))
123
124 (luna-define-method elmo-folder-pack-number ((folder elmo-map-folder))
125   (let* ((msgdb (elmo-folder-msgdb folder))
126          (old-number-alist (elmo-msgdb-get-number-alist msgdb))
127          (old-overview (elmo-msgdb-get-overview msgdb))
128          (old-mark-alist (elmo-msgdb-get-mark-alist msgdb))
129          (old-location (elmo-map-folder-location-alist-internal folder))
130          old-number overview number-alist mark-alist location
131          mark (number 1))
132     (setq overview old-overview)
133     (while old-overview
134       (setq old-number
135             (elmo-msgdb-overview-entity-get-number (car old-overview)))
136       (elmo-msgdb-overview-entity-set-number (car old-overview) number)
137       (setq number-alist
138             (cons (cons number (cdr (assq old-number old-number-alist)))
139                   number-alist))
140       (when (setq mark (cadr (assq old-number old-mark-alist)))
141         (setq mark-alist
142               (elmo-msgdb-mark-append
143                mark-alist number mark)))
144       (setq location
145             (cons (cons number
146                         (elmo-map-message-location folder old-number))
147                   location))
148       (setq number (1+ number))
149       (setq old-overview (cdr old-overview)))
150     (elmo-map-folder-location-setup folder (nreverse location))
151     (elmo-folder-set-msgdb-internal
152      folder
153      (elmo-make-msgdb overview
154                       (nreverse number-alist)
155                       (nreverse mark-alist)))))
156
157 (defun elmo-map-folder-location-setup (folder locations)
158   (elmo-map-folder-set-location-alist-internal
159    folder
160    locations)
161   (elmo-map-folder-set-location-hash-internal
162    folder (elmo-make-hash
163            (* 2 (length locations))))
164   (elmo-map-folder-set-number-max-internal folder 0)
165   ;; Set number-max and hashtables.
166   (dolist (location-cons locations)
167     (if (< (elmo-map-folder-number-max-internal folder)
168            (car location-cons))
169         (elmo-map-folder-set-number-max-internal folder (car location-cons)))
170     (elmo-set-hash-val (cdr location-cons)
171                        location-cons
172                        (elmo-map-folder-location-hash-internal folder))
173     (elmo-set-hash-val (concat "#" (int-to-string (car location-cons)))
174                        location-cons
175                        (elmo-map-folder-location-hash-internal folder))))
176
177 (defun elmo-map-folder-update-locations (folder locations)
178   ;; A subroutine to make location-alist.
179   ;; location-alist is existing location-alist.
180   ;; locations is the newest locations.
181   (let* ((location-alist (elmo-map-folder-location-alist-internal folder))
182          (locations-in-db (mapcar 'cdr location-alist))
183          new-locs new-alist deleted-locs pair i)
184     (setq new-locs
185           (elmo-delete-if (function
186                            (lambda (x) (member x locations-in-db)))
187                           locations))
188     (setq deleted-locs
189           (elmo-delete-if (function
190                            (lambda (x) (member x locations)))
191                           locations-in-db))
192     (dolist (location deleted-locs)
193       (setq location-alist
194             (delq (setq pair
195                         (elmo-get-hash-val
196                          location
197                          (elmo-map-folder-location-hash-internal
198                           folder)))
199                   location-alist))
200       (when pair
201         (elmo-clear-hash-val (concat "#" (int-to-string (car pair)))
202                              (elmo-map-folder-location-hash-internal
203                               folder))
204         (elmo-clear-hash-val location
205                              (elmo-map-folder-location-hash-internal
206                               folder))))
207     (setq i (elmo-map-folder-number-max-internal folder))
208     (dolist (location new-locs)
209       (setq i (1+ i))
210       (elmo-map-folder-set-number-max-internal folder i)
211       (setq new-alist (cons (setq pair (cons i location)) new-alist))
212       (setq new-alist (nreverse new-alist))
213       (elmo-set-hash-val (concat "#" (int-to-string i))
214                          pair
215                          (elmo-map-folder-location-hash-internal
216                           folder))
217       (elmo-set-hash-val location
218                          pair
219                          (elmo-map-folder-location-hash-internal
220                           folder)))
221     (setq location-alist
222           (sort (nconc location-alist new-alist)
223                 (lambda (x y) (< (car x) (car y)))))
224     (elmo-map-folder-set-location-alist-internal folder location-alist)))
225
226 (luna-define-method elmo-folder-open-internal ((folder elmo-map-folder))
227   (elmo-map-folder-location-setup
228    folder 
229    (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))
230   (if (elmo-folder-plugged-p folder)
231       (elmo-map-folder-update-locations
232        folder
233        (elmo-map-folder-list-message-locations folder))))
234
235 (luna-define-method elmo-folder-commit :after ((folder elmo-map-folder))
236   (when (elmo-folder-persistent-p folder)
237     (elmo-msgdb-location-save (elmo-folder-msgdb-path folder)
238                               (elmo-map-folder-location-alist-internal
239                                folder))))
240
241 (luna-define-method elmo-folder-close-internal ((folder elmo-map-folder))
242   (elmo-map-folder-set-location-alist-internal folder nil)
243   (elmo-map-folder-set-location-hash-internal folder nil))
244   
245 (luna-define-method elmo-folder-check ((folder elmo-map-folder))
246   (elmo-map-folder-update-locations
247    folder
248    (elmo-map-folder-list-message-locations folder)))
249
250 (luna-define-method elmo-folder-clear :around ((folder elmo-map-folder)
251                                                &optional keep-killed)
252   (unless keep-killed
253     (elmo-map-folder-set-number-max-internal folder 0)
254     (elmo-map-folder-set-location-alist-internal folder nil)
255     ;; clear hashtable.
256     (elmo-map-folder-set-location-hash-internal folder (elmo-make-hash)))
257   (luna-call-next-method))
258
259 (luna-define-method elmo-folder-list-messages-internal
260   ((folder elmo-map-folder) &optional nohide)
261   (mapcar 'car (elmo-map-folder-location-alist-internal folder)))
262
263 (luna-define-method elmo-folder-unmark-important ((folder elmo-map-folder)
264                                                   numbers)
265   (elmo-map-folder-unmark-important
266    folder
267    (elmo-map-folder-numbers-to-locations folder numbers)))
268
269 (luna-define-method elmo-folder-mark-as-important ((folder elmo-map-folder)
270                                                    numbers)
271   (elmo-map-folder-mark-as-important
272    folder
273    (elmo-map-folder-numbers-to-locations folder numbers)))
274
275 (luna-define-method elmo-folder-unmark-read ((folder elmo-map-folder)
276                                              numbers)
277   (elmo-map-folder-unmark-read
278    folder
279    (elmo-map-folder-numbers-to-locations folder numbers)))
280
281 (luna-define-method elmo-folder-mark-as-read ((folder elmo-map-folder) numbers)
282   (elmo-map-folder-mark-as-read
283    folder
284    (elmo-map-folder-numbers-to-locations folder numbers)))
285
286 (luna-define-method elmo-message-fetch-internal ((folder elmo-map-folder)
287                                                  number strategy
288                                                  &optional section unread)
289   (elmo-map-message-fetch
290    folder
291    (elmo-map-message-location folder number)
292    strategy section unread))
293
294 (luna-define-method elmo-folder-list-unreads-internal
295   ((folder elmo-map-folder) unread-marks &optional mark-alist)
296   (elmo-map-folder-locations-to-numbers
297    folder
298    (elmo-map-folder-list-unreads folder)))
299
300 (luna-define-method elmo-folder-list-importants-internal
301   ((folder elmo-map-folder) important-mark)
302   (let ((locations (elmo-map-folder-list-importants folder)))
303     (if (listp locations)
304         (elmo-map-folder-locations-to-numbers folder locations)
305       t)))
306
307 (luna-define-method elmo-folder-delete-messages ((folder elmo-map-folder)
308                                                  numbers)
309   (elmo-map-folder-delete-messages
310    folder
311    (elmo-map-folder-numbers-to-locations folder numbers))
312   (dolist (number numbers)
313     (elmo-map-folder-set-location-alist-internal
314      folder
315      (delq (elmo-get-hash-val
316             (concat "#" (int-to-string number))
317             (elmo-map-folder-location-hash-internal
318              folder))
319            (elmo-map-folder-location-alist-internal folder))))
320   t) ; success
321   
322
323 (require 'product)
324 (product-provide (provide 'elmo-map) (require 'elmo-version))
325
326 ;;; elmo-map.el ends here