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 (luna-define-class elmo-location-map ()
39 (location-alist location-hash max-number)))
41 (defmacro elmo-location-map-alist (entity)
42 `(luna-slot-value ,entity 'location-alist))
44 (defmacro elmo-location-map-set-alist (entity value)
45 `(luna-set-slot-value ,entity 'location-alist ,value))
47 (defmacro elmo-location-map-hash (entity)
48 `(luna-slot-value ,entity 'location-hash))
50 (defmacro elmo-location-map-set-hash (entity value)
51 `(luna-set-slot-value ,entity 'location-hash ,value))
53 (defmacro elmo-location-map-max-number (entity)
54 `(luna-slot-value ,entity 'max-number))
56 (defmacro elmo-location-map-set-max-number (entity value)
57 `(luna-set-slot-value ,entity 'max-number ,value))
60 (defmacro elmo-location-map-key (number)
61 `(concat "#" (number-to-string ,number)))
63 (defun elmo-location-map-load (location-map directory)
64 (elmo-location-map-setup
66 (elmo-msgdb-location-load directory)))
68 (defun elmo-location-map-save (location-map directory)
69 (let ((alist (elmo-location-map-alist location-map)))
70 (elmo-msgdb-location-save
72 (cons (cons (elmo-location-map-max-number location-map) nil)
75 (defun elmo-location-map-setup (location-map &optional locations)
76 "Setup internal data of LOCATION-MAP by LOCATIONS.
77 Return a location alist."
78 (let ((hash (elmo-make-hash (length locations)))
80 ;; Set number-max and hashtables.
81 (dolist (pair locations)
82 (setq max-number (max max-number (car pair)))
84 (elmo-set-hash-val (cdr pair) pair hash)
85 (elmo-set-hash-val (elmo-location-map-key (car pair)) pair hash)))
86 (let ((inhibit-quit t))
87 (elmo-location-map-set-max-number location-map max-number)
88 (elmo-location-map-set-hash location-map hash)
89 (elmo-location-map-set-alist location-map locations))))
91 (defun elmo-location-map-teardown (location-map)
92 (elmo-location-map-set-alist location-map nil)
93 (elmo-location-map-set-hash location-map nil))
95 (defun elmo-location-map-update (location-map locations)
96 "Update location alist in LOCATION-MAP by LOCATIONS.
97 Return new location alist."
98 (let ((old-hash (elmo-location-map-hash location-map))
99 (new-hash (elmo-make-hash (length locations)))
100 (number (elmo-location-map-max-number location-map))
105 (let ((entry (or (elmo-get-hash-val location old-hash)
106 (cons (setq number (1+ number)) location))))
107 (elmo-set-hash-val (elmo-location-map-key (car entry))
110 (elmo-set-hash-val location entry new-hash)
113 (let ((inhibit-quit t))
114 (elmo-location-map-set-max-number location-map number)
115 (elmo-location-map-set-hash location-map new-hash)
116 (elmo-location-map-set-alist location-map new-alist))))
118 (defun elmo-location-map-remove-numbers (location-map numbers)
119 (let ((alist (elmo-location-map-alist location-map))
120 (hash (elmo-location-map-hash location-map)))
121 (dolist (number numbers)
122 (let* ((key (elmo-location-map-key number))
123 (entry (elmo-get-hash-val key hash))
125 (elmo-location-map-set-alist
127 (setq alist (delq entry alist)))
128 (elmo-clear-hash-val key hash)
129 (elmo-clear-hash-val (cdr entry) hash)))))
131 (defun elmo-map-message-number (location-map location)
132 "Return number of the message in the MAPPER with LOCATION."
133 (car (elmo-get-hash-val
135 (elmo-location-map-hash location-map))))
137 (defun elmo-map-message-location (location-map number)
138 "Return location of the message in the MAPPER with NUMBER."
139 (cdr (elmo-get-hash-val
140 (elmo-location-map-key number)
141 (elmo-location-map-hash location-map))))
143 (defun elmo-map-numbers-to-locations (location-map numbers)
144 (let (locations pair)
145 (dolist (number numbers)
146 (if (setq pair (elmo-get-hash-val
147 (elmo-location-map-key number)
148 (elmo-location-map-hash location-map)))
149 (setq locations (cons (cdr pair) locations))))
150 (nreverse locations)))
152 (defun elmo-map-locations-to-numbers (location-map locations)
154 (dolist (location locations)
155 (if (setq pair (elmo-get-hash-val
157 (elmo-location-map-hash location-map)))
158 (setq numbers (cons (car pair) numbers))))
163 (luna-define-class elmo-map-folder (elmo-folder elmo-location-map))
164 (luna-define-internal-accessors 'elmo-map-folder))
166 (luna-define-generic elmo-map-folder-list-message-locations (folder)
167 "Return a location list of the FOLDER.")
169 (luna-define-generic elmo-map-folder-set-flag (folder locations flag)
170 "Set FLAG to LOCATIONS.")
172 (luna-define-generic elmo-map-folder-unset-flag (folder locations flag)
173 "Unset FLAG from LOCATIONS.")
175 (luna-define-generic elmo-map-message-fetch (folder location
182 (luna-define-generic elmo-map-folder-delete-messages (folder locations)
185 (luna-define-method elmo-folder-status ((folder elmo-map-folder))
186 (elmo-folder-open-internal folder)
187 (elmo-folder-set-killed-list-internal
189 (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
190 (let ((numbers (mapcar
192 (elmo-location-map-alist folder))))
193 (setq numbers (elmo-living-messages
195 (elmo-folder-killed-list-internal folder)))
197 (cons (elmo-max-of-list numbers)
199 ;; Don't close after status.
200 (unless (elmo-folder-reserve-status-p folder)
201 (elmo-folder-close-internal folder)))))
203 (luna-define-method elmo-folder-pack-numbers ((folder elmo-map-folder))
204 (let* ((msgdb (elmo-folder-msgdb folder))
206 (sort (elmo-folder-list-messages folder nil
207 (not elmo-pack-number-check-strict))
209 (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
212 (elmo-with-progress-display (elmo-folder-pack-numbers (length numbers))
214 (dolist (old-number numbers)
215 (setq entity (elmo-msgdb-message-entity msgdb old-number))
216 (elmo-message-entity-set-number entity number)
217 (elmo-msgdb-append-entity new-msgdb entity
218 (elmo-msgdb-flags msgdb old-number))
221 (elmo-map-message-location folder old-number))
223 (elmo-emit-signal 'message-number-changed folder old-number number)
224 (setq number (1+ number))))
225 (message "Packing...done")
226 (elmo-location-map-setup folder (nreverse location))
227 (elmo-folder-set-msgdb-internal folder new-msgdb)))
229 (luna-define-method elmo-folder-open-internal ((folder elmo-map-folder))
230 (unless (elmo-location-map-alist folder)
231 (elmo-location-map-load folder (elmo-folder-msgdb-path folder)))
232 (when (elmo-folder-plugged-p folder)
233 (elmo-location-map-update
235 (elmo-map-folder-list-message-locations folder))))
237 (luna-define-method elmo-folder-commit :after ((folder elmo-map-folder))
238 (when (elmo-folder-persistent-p folder)
239 (elmo-location-map-save folder (elmo-folder-msgdb-path folder))))
241 (luna-define-method elmo-folder-close-internal ((folder elmo-map-folder))
242 (elmo-location-map-teardown folder))
244 (luna-define-method elmo-folder-check ((folder elmo-map-folder))
245 (elmo-location-map-update
247 (elmo-map-folder-list-message-locations folder)))
249 (luna-define-method elmo-folder-next-message-number ((folder elmo-map-folder))
250 (1+ (elmo-location-map-max-number folder)))
252 (luna-define-method elmo-folder-clear :around ((folder elmo-map-folder)
253 &optional keep-killed)
255 (elmo-location-map-setup folder))
256 (luna-call-next-method))
258 (luna-define-method elmo-folder-list-messages-internal
259 ((folder elmo-map-folder) &optional nohide)
260 (mapcar 'car (elmo-location-map-alist folder)))
262 (luna-define-method elmo-folder-set-flag :before ((folder elmo-map-folder)
267 (elmo-map-folder-set-flag
269 (elmo-map-numbers-to-locations folder numbers)
272 (luna-define-method elmo-folder-unset-flag :before ((folder elmo-map-folder)
277 (elmo-map-folder-unset-flag
279 (elmo-map-numbers-to-locations folder numbers)
282 (luna-define-method elmo-message-fetch-internal ((folder elmo-map-folder)
284 &optional section unread)
285 (elmo-map-message-fetch
287 (elmo-map-message-location folder number)
288 strategy section unread))
290 (luna-define-method elmo-folder-list-flagged-internal ((folder elmo-map-folder)
292 (let ((locations (elmo-map-folder-list-flagged folder flag)))
293 (if (listp locations)
294 (elmo-map-locations-to-numbers folder locations)
297 (luna-define-generic elmo-map-folder-list-flagged (folder flag)
298 "Return a list of message location in the FOLDER with FLAG.
299 Return t if the message list is not available.")
301 (luna-define-method elmo-map-folder-list-flagged ((folder elmo-map-folder)
305 (luna-define-method elmo-folder-delete-messages-internal ((folder
308 (elmo-map-folder-delete-messages
310 (elmo-map-numbers-to-locations folder numbers)))
312 (luna-define-method elmo-folder-detach-messages :around ((folder
315 (when (luna-call-next-method)
316 (elmo-location-map-remove-numbers folder numbers)
320 (product-provide (provide 'elmo-map) (require 'elmo-version))
322 ;;; elmo-map.el ends here