(elmo-imap4-flags-to-imap): Preserve argument
[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-set-flag (folder locations flag)
66   "Set FLAG to LOCATIONS.")
67
68 (luna-define-generic elmo-map-folder-unset-flag (folder locations flag)
69   "Unset FLAG from LOCATIONS.")
70
71 (luna-define-generic elmo-map-message-fetch (folder location
72                                                     strategy
73                                                     &optional
74                                                     section
75                                                     unseen)
76   "")
77
78 (luna-define-generic elmo-map-folder-delete-messages (folder locations)
79   "")
80
81 (luna-define-method elmo-folder-status ((folder elmo-map-folder))
82   (elmo-folder-open-internal folder)
83   (elmo-folder-set-killed-list-internal
84    folder
85    (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
86   (let ((numbers (mapcar
87                   'car
88                   (elmo-map-folder-location-alist-internal folder))))
89     (setq numbers (elmo-living-messages
90                    numbers
91                    (elmo-folder-killed-list-internal folder)))
92     (prog1
93         (cons (elmo-max-of-list numbers)
94               (length numbers))
95       ;; Don't close after status.
96       (unless (elmo-folder-reserve-status-p folder)
97         (elmo-folder-close-internal folder)))))
98
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
102         location
103         (elmo-map-folder-location-hash-internal folder))))
104
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))))
110
111 (luna-define-method elmo-folder-pack-numbers ((folder elmo-map-folder))
112   (let* ((msgdb (elmo-folder-msgdb folder))
113          (numbers (sort (elmo-folder-list-messages folder nil 'in-msgdb) '<))
114          (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
115          (number 1)
116          total location entity)
117     (setq total (length numbers))
118     (elmo-with-progress-display (> total elmo-display-progress-threshold)
119         (elmo-folder-pack-numbers total "Packing...")
120       (dolist (old-number numbers)
121         (setq entity (elmo-msgdb-message-entity msgdb old-number))
122         (elmo-message-entity-set-number entity number)
123         (elmo-msgdb-append-entity new-msgdb entity
124                                   (elmo-msgdb-flags msgdb old-number))
125         (setq location
126               (cons (cons number
127                           (elmo-map-message-location folder old-number))
128                     location))
129         (setq number (1+ number))))
130     (message "Packing...done")
131     (elmo-map-folder-location-setup folder (nreverse location))
132     (elmo-folder-set-msgdb-internal folder new-msgdb)))
133
134 (defun elmo-map-folder-location-setup (folder locations)
135   (elmo-map-folder-set-location-alist-internal
136    folder
137    locations)
138   (elmo-map-folder-set-location-hash-internal
139    folder (elmo-make-hash
140            (* 2 (length locations))))
141   (elmo-map-folder-set-number-max-internal folder 0)
142   ;; Set number-max and hashtables.
143   (dolist (location-cons locations)
144     (if (< (elmo-map-folder-number-max-internal folder)
145            (car location-cons))
146         (elmo-map-folder-set-number-max-internal folder (car location-cons)))
147     (elmo-set-hash-val (cdr location-cons)
148                        location-cons
149                        (elmo-map-folder-location-hash-internal folder))
150     (elmo-set-hash-val (concat "#" (int-to-string (car location-cons)))
151                        location-cons
152                        (elmo-map-folder-location-hash-internal folder))))
153
154 (defun elmo-map-folder-update-locations (folder locations)
155   ;; A subroutine to make location-alist.
156   ;; location-alist is existing location-alist.
157   ;; locations is the newest locations.
158   (let* ((location-alist (elmo-map-folder-location-alist-internal folder))
159          (locations-in-db (mapcar 'cdr location-alist))
160          new-locs new-alist deleted-locs pair i)
161     (setq new-locs
162           (elmo-delete-if (function
163                            (lambda (x) (member x locations-in-db)))
164                           locations))
165     (setq deleted-locs
166           (elmo-delete-if (function
167                            (lambda (x) (member x locations)))
168                           locations-in-db))
169     (dolist (location deleted-locs)
170       (setq location-alist
171             (delq (setq pair
172                         (elmo-get-hash-val
173                          location
174                          (elmo-map-folder-location-hash-internal
175                           folder)))
176                   location-alist))
177       (when pair
178         (elmo-clear-hash-val (concat "#" (int-to-string (car pair)))
179                              (elmo-map-folder-location-hash-internal
180                               folder))
181         (elmo-clear-hash-val location
182                              (elmo-map-folder-location-hash-internal
183                               folder))))
184     (setq i (elmo-map-folder-number-max-internal folder))
185     (dolist (location new-locs)
186       (setq i (1+ i))
187       (elmo-map-folder-set-number-max-internal folder i)
188       (setq new-alist (cons (setq pair (cons i location)) new-alist))
189       (setq new-alist (nreverse new-alist))
190       (elmo-set-hash-val (concat "#" (int-to-string i))
191                          pair
192                          (elmo-map-folder-location-hash-internal
193                           folder))
194       (elmo-set-hash-val location
195                          pair
196                          (elmo-map-folder-location-hash-internal
197                           folder)))
198     (setq location-alist
199           (sort (nconc location-alist new-alist)
200                 (lambda (x y) (< (car x) (car y)))))
201     (elmo-map-folder-set-location-alist-internal folder location-alist)))
202
203 (luna-define-method elmo-folder-open-internal ((folder elmo-map-folder))
204   (elmo-map-folder-location-setup
205    folder
206    (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))
207   (if (elmo-folder-plugged-p folder)
208       (elmo-map-folder-update-locations
209        folder
210        (elmo-map-folder-list-message-locations folder))))
211
212 (luna-define-method elmo-folder-commit :after ((folder elmo-map-folder))
213   (when (elmo-folder-persistent-p folder)
214     (elmo-msgdb-location-save (elmo-folder-msgdb-path folder)
215                               (elmo-map-folder-location-alist-internal
216                                folder))))
217
218 (luna-define-method elmo-folder-close-internal ((folder elmo-map-folder))
219   (elmo-map-folder-set-location-alist-internal folder nil)
220   (elmo-map-folder-set-location-hash-internal folder nil))
221
222 (luna-define-method elmo-folder-check ((folder elmo-map-folder))
223   (elmo-map-folder-update-locations
224    folder
225    (elmo-map-folder-list-message-locations folder)))
226
227 (luna-define-method elmo-folder-next-message-number ((folder elmo-map-folder))
228   (1+ (elmo-map-folder-number-max-internal folder)))
229
230 (luna-define-method elmo-folder-clear :around ((folder elmo-map-folder)
231                                                &optional keep-killed)
232   (unless keep-killed
233     (elmo-map-folder-set-number-max-internal folder 0)
234     (elmo-map-folder-set-location-alist-internal folder nil)
235     ;; clear hashtable.
236     (elmo-map-folder-set-location-hash-internal folder (elmo-make-hash)))
237   (luna-call-next-method))
238
239 (luna-define-method elmo-folder-list-messages-internal
240   ((folder elmo-map-folder) &optional nohide)
241   (mapcar 'car (elmo-map-folder-location-alist-internal folder)))
242
243 (luna-define-method elmo-folder-set-flag :before ((folder elmo-map-folder)
244                                                   numbers
245                                                   flag
246                                                   &optional is-local)
247   (unless is-local
248     (elmo-map-folder-set-flag
249      folder
250      (elmo-map-folder-numbers-to-locations folder numbers)
251      flag)))
252
253 (luna-define-method elmo-folder-unset-flag :before ((folder elmo-map-folder)
254                                                     numbers
255                                                     flag
256                                                     &optional is-local)
257   (unless is-local
258     (elmo-map-folder-unset-flag
259      folder
260      (elmo-map-folder-numbers-to-locations folder numbers)
261      flag)))
262
263 (luna-define-method elmo-message-fetch-internal ((folder elmo-map-folder)
264                                                  number strategy
265                                                  &optional section unread)
266   (elmo-map-message-fetch
267    folder
268    (elmo-map-message-location folder number)
269    strategy section unread))
270
271 (luna-define-method elmo-folder-list-flagged-internal ((folder elmo-map-folder)
272                                                        flag)
273   (let ((locations (elmo-map-folder-list-flagged folder flag)))
274     (if (listp locations)
275         (elmo-map-folder-locations-to-numbers folder locations)
276       t)))
277
278 (luna-define-generic elmo-map-folder-list-flagged (folder flag)
279   "Return a list of message location in the FOLDER with FLAG.
280 Return t if the message list is not available.")
281
282 (luna-define-method elmo-map-folder-list-flagged ((folder elmo-map-folder)
283                                                   flag)
284   t)
285
286 (luna-define-method elmo-folder-delete-messages-internal ((folder
287                                                            elmo-map-folder)
288                                                           numbers)
289   (elmo-map-folder-delete-messages
290    folder
291    (elmo-map-folder-numbers-to-locations folder numbers)))
292
293 (luna-define-method elmo-folder-detach-messages :around ((folder
294                                                           elmo-map-folder)
295                                                          numbers)
296   (when (luna-call-next-method)
297     (dolist (number numbers)
298       (elmo-map-folder-set-location-alist-internal
299        folder
300        (delq (elmo-get-hash-val
301               (concat "#" (int-to-string number))
302               (elmo-map-folder-location-hash-internal
303                folder))
304              (elmo-map-folder-location-alist-internal folder)))
305       (elmo-clear-hash-val (concat "#" (int-to-string number))
306                            (elmo-map-folder-location-hash-internal
307                             folder)))
308     t)) ; success
309
310 (require 'product)
311 (product-provide (provide 'elmo-map) (require 'elmo-version))
312
313 ;;; elmo-map.el ends here