1 ;;; modb-standard.el --- Standartd Implement of MODB.
3 ;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
7 ;; Keywords: mail, net news
9 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
32 (eval-when-compile (require 'cl))
38 (defcustom modb-standard-divide-number 500
39 "*Standard modb divide entity number."
40 :type '(choice (const :tag "Not divide" nil)
44 (defvar modb-standard-entity-filename "entity"
45 "Message entity database.")
47 (defvar modb-standard-flag-filename "flag"
48 "Message number <=> Flag status database.")
50 (defvar modb-standard-msgid-filename "msgid"
51 "Message number <=> Message-Id database.")
54 (luna-define-class modb-standard (modb-generic)
55 (number-list ; sorted list of message numbers.
56 entity-map ; number, msg-id -> entity mapping.
57 flag-map ; number -> flag-list mapping
59 (luna-define-internal-accessors 'modb-standard))
61 ;; for internal use only
62 (defsubst modb-standard-key (number)
63 (concat "#" (number-to-string number)))
65 (defsubst modb-standard-entity-id (entity)
66 (if (eq 'autoload (car-safe entity))
68 (elmo-msgdb-message-entity-field
69 (elmo-message-entity-handler entity)
72 (defsubst modb-standard-entity-map (modb)
73 (or (modb-standard-entity-map-internal modb)
74 (modb-standard-set-entity-map-internal
76 (elmo-make-hash (elmo-msgdb-length modb)))))
78 (defsubst modb-standard-flag-map (modb)
79 (or (modb-standard-flag-map-internal modb)
80 (modb-standard-set-flag-map-internal
82 (elmo-make-hash (elmo-msgdb-length modb)))))
84 (defsubst modb-standard-set-message-modified (modb number)
85 (if modb-standard-divide-number
86 (let ((section (/ number modb-standard-divide-number))
87 (modified (modb-generic-message-modified-internal modb)))
88 (unless (memq section modified)
89 (modb-generic-set-message-modified-internal
90 modb (cons section modified))))
91 (modb-generic-set-message-modified-internal modb t)))
93 (defsubst modb-standard-set-flag-modified (modb number)
94 (modb-generic-set-flag-modified-internal modb t))
96 (defsubst modb-standard-message-flags (modb number)
97 (cdr (elmo-get-hash-val (modb-standard-key number)
98 (modb-standard-flag-map-internal modb))))
100 (defsubst modb-standard-match-flags (check-flags flags)
103 (when (memq (car check-flags) flags)
105 (setq check-flags (cdr check-flags)))))
108 ;; save and load functions
109 (defun modb-standard-load-msgid (modb path)
110 (let* ((alist (elmo-object-load
111 (expand-file-name modb-standard-msgid-filename path)))
112 (table (or (modb-standard-entity-map-internal modb)
113 (elmo-make-hash (length alist))))
116 (setq info (cons 'autoload pair))
117 (elmo-set-hash-val (modb-standard-key (car pair)) info table)
118 (elmo-set-hash-val (cdr pair) info table)
119 (setq numbers (cons (car pair) numbers)))
120 (modb-standard-set-number-list-internal modb (nreverse numbers))
121 (modb-standard-set-entity-map-internal modb table)))
123 (defun modb-standard-save-msgid (modb path)
124 (let ((table (modb-standard-entity-map-internal modb))
126 (dolist (number (modb-standard-number-list-internal modb))
127 (setq entity (elmo-get-hash-val (modb-standard-key number) table))
128 (setq alist (cons (cons number (modb-standard-entity-id entity))
131 (expand-file-name modb-standard-msgid-filename path)
134 (defun modb-standard-load-flag (modb path)
135 (let ((table (or (modb-standard-flag-map-internal modb)
136 (elmo-make-hash (elmo-msgdb-length modb)))))
137 (dolist (info (elmo-object-load
138 (expand-file-name modb-standard-flag-filename path)))
139 (elmo-set-hash-val (modb-standard-key (car info)) info table))
140 (modb-standard-set-flag-map-internal modb table)))
142 (defun modb-standard-save-flag (modb path)
143 (let (table flist info)
144 (when (setq table (modb-standard-flag-map-internal modb))
147 (setq info (symbol-value atom))
149 (setq flist (cons info flist))))
152 (expand-file-name modb-standard-flag-filename path)
155 (defsubst modb-standard-entity-filename (section)
157 (concat modb-standard-entity-filename
159 (number-to-string section))
160 modb-standard-entity-filename))
162 (defun modb-standard-load-entity (modb path &optional section)
163 (let ((table (or (modb-standard-entity-map-internal modb)
164 (elmo-make-hash (elmo-msgdb-length modb)))))
165 (dolist (entity (elmo-object-load
167 (modb-standard-entity-filename section)
169 (elmo-set-hash-val (modb-standard-key
170 (elmo-msgdb-message-entity-number
171 (elmo-message-entity-handler entity)
175 (elmo-set-hash-val (elmo-msgdb-message-entity-field
176 (elmo-message-entity-handler entity)
180 (modb-standard-set-entity-map-internal modb table)))
182 (defsubst modb-standard-save-entity-1 (modb path &optional section)
183 (let ((table (modb-standard-entity-map-internal modb))
184 (filename (expand-file-name
185 (modb-standard-entity-filename section) path))
187 (dolist (number (modb-standard-number-list-internal modb))
188 (when (and (or (null section)
189 (= section (/ number modb-standard-divide-number)))
190 (setq entity (elmo-msgdb-message-entity modb number)))
191 (setq entities (cons entity entities))))
193 (elmo-object-save filename entities)
194 (ignore-errors (delete-file filename)))))
196 (defun modb-standard-save-entity (modb path)
197 (let ((sections (modb-generic-message-modified-internal modb)))
198 (cond ((listp sections)
199 (dolist (section sections)
200 (modb-standard-save-entity-1 modb path section)))
202 (modb-standard-save-entity-1 modb path)))))
206 (luna-define-method elmo-msgdb-load ((msgdb modb-standard))
207 (let ((inhibit-quit t)
208 (path (elmo-msgdb-location msgdb)))
209 (when (file-exists-p (expand-file-name modb-standard-flag-filename path))
210 (modb-standard-load-msgid msgdb path)
211 (modb-standard-load-flag msgdb path)
212 (unless modb-standard-divide-number
213 (modb-standard-load-entity msgdb path))
216 (luna-define-method elmo-msgdb-save ((msgdb modb-standard))
217 (let ((path (elmo-msgdb-location msgdb)))
218 (when (elmo-msgdb-message-modified-p msgdb)
219 (modb-standard-save-msgid msgdb path)
220 (modb-standard-save-entity msgdb path)
221 (modb-generic-set-message-modified-internal msgdb nil))
222 (when (elmo-msgdb-flag-modified-p msgdb)
223 (modb-standard-save-flag msgdb path)
224 (modb-generic-set-flag-modified-internal msgdb nil))))
226 (luna-define-method elmo-msgdb-append :around ((msgdb modb-standard)
228 (when (> (elmo-msgdb-length msgdb-append) 0)
229 (if (eq (luna-class-name msgdb-append) 'modb-standard)
230 (let ((numbers (modb-standard-number-list-internal msgdb-append))
233 (modb-standard-set-number-list-internal
235 (nconc (modb-standard-number-list-internal msgdb)
238 (let ((table (modb-standard-entity-map msgdb))
240 (dolist (number numbers)
241 (setq entity (elmo-msgdb-message-entity msgdb-append number)
242 msg-id (modb-standard-entity-id entity))
243 (if (elmo-get-hash-val msg-id table)
244 (setq duplicates (cons number duplicates))
245 (elmo-set-hash-val msg-id entity table))
246 (elmo-set-hash-val (modb-standard-key number)
250 (let ((table (modb-standard-flag-map msgdb)))
253 (elmo-set-hash-val (symbol-name atom)
256 (modb-standard-flag-map msgdb-append)))
257 ;; modification flags
258 (dolist (number (modb-standard-number-list-internal msgdb-append))
259 (modb-standard-set-message-modified msgdb number)
260 (modb-standard-set-flag-modified msgdb number))
262 (luna-call-next-method))))
264 (luna-define-method elmo-msgdb-clear :after ((msgdb modb-standard))
265 (modb-standard-set-number-list-internal msgdb nil)
266 (modb-standard-set-entity-map-internal msgdb nil)
267 (modb-standard-set-flag-map-internal msgdb nil))
269 (luna-define-method elmo-msgdb-length ((msgdb modb-standard))
270 (length (modb-standard-number-list-internal msgdb)))
272 (luna-define-method elmo-msgdb-flags ((msgdb modb-standard) number)
273 (modb-standard-message-flags msgdb number))
275 (luna-define-method elmo-msgdb-set-flag ((msgdb modb-standard)
279 (elmo-msgdb-unset-flag msgdb number 'unread))
281 (elmo-msgdb-unset-flag msgdb number 'cached))
283 (let* ((cur-flags (modb-standard-message-flags msgdb number))
284 (new-flags (copy-sequence cur-flags)))
285 (and (memq 'new new-flags)
286 (setq new-flags (delq 'new new-flags)))
287 (or (memq flag new-flags)
288 (setq new-flags (cons flag new-flags)))
289 (when (and (eq flag 'unread)
290 (memq 'answered new-flags))
291 (setq new-flags (delq 'answered new-flags)))
292 (unless (equal new-flags cur-flags)
293 (elmo-set-hash-val (modb-standard-key number)
294 (cons number new-flags)
295 (modb-standard-flag-map msgdb))
296 (modb-standard-set-flag-modified msgdb number))))))
298 (luna-define-method elmo-msgdb-unset-flag ((msgdb modb-standard)
302 (elmo-msgdb-set-flag msgdb number 'unread))
304 (elmo-msgdb-set-flag msgdb number 'cached))
306 (let* ((cur-flags (modb-standard-message-flags msgdb number))
307 (new-flags (copy-sequence cur-flags)))
308 (and (memq 'new new-flags)
309 (setq new-flags (delq 'new new-flags)))
310 (and (memq flag new-flags)
311 (setq new-flags (delq flag new-flags)))
312 (when (and (eq flag 'unread)
313 (memq 'answered new-flags))
314 (setq new-flags (delq 'answered new-flags)))
315 (unless (equal new-flags cur-flags)
316 (elmo-set-hash-val (modb-standard-key number)
317 (cons number new-flags)
318 (modb-standard-flag-map msgdb))
319 (modb-standard-set-flag-modified msgdb number))))))
321 (luna-define-method elmo-msgdb-list-messages ((msgdb modb-standard))
323 (modb-standard-number-list-internal msgdb)))
325 (luna-define-method elmo-msgdb-list-flagged ((msgdb modb-standard) flag)
329 (dolist (number (modb-standard-number-list-internal msgdb))
330 (unless (memq 'unread (modb-standard-message-flags msgdb number))
331 (setq matched (cons number matched)))))
335 (setq entry (symbol-value atom))
336 (when (modb-standard-match-flags '(unread important)
338 (setq matched (cons (car entry) matched))))
339 (modb-standard-flag-map msgdb)))
343 (setq entry (symbol-value atom))
344 (when (modb-standard-match-flags '(unread important answered)
346 (setq matched (cons (car entry) matched))))
347 (modb-standard-flag-map msgdb)))
351 (setq entry (symbol-value atom))
352 (when (memq flag (cdr entry))
353 (setq matched (cons (car entry) matched))))
354 (modb-standard-flag-map msgdb))))
357 (luna-define-method elmo-msgdb-append-entity ((msgdb modb-standard)
358 entity &optional flags)
359 (let ((number (elmo-msgdb-message-entity-number
360 (elmo-message-entity-handler entity) entity))
361 (msg-id (elmo-msgdb-message-entity-field
362 (elmo-message-entity-handler entity) entity 'message-id))
365 (modb-standard-set-number-list-internal
367 (nconc (modb-standard-number-list-internal msgdb)
370 (let ((table (modb-standard-entity-map msgdb)))
371 (setq duplicate (elmo-get-hash-val msg-id table))
372 (elmo-set-hash-val (modb-standard-key number) entity table)
373 (elmo-set-hash-val msg-id entity table))
374 ;; modification flags
375 (modb-standard-set-message-modified msgdb number)
379 (modb-standard-key number)
381 (modb-standard-flag-map msgdb))
382 (modb-standard-set-flag-modified msgdb number))
385 (luna-define-method elmo-msgdb-delete-messages ((msgdb modb-standard)
387 (let ((number-list (modb-standard-number-list-internal msgdb))
388 (entity-map (modb-standard-entity-map-internal msgdb))
389 (flag-map (modb-standard-flag-map-internal msgdb))
391 (dolist (number numbers)
392 (setq key (modb-standard-key number)
393 entity (elmo-get-hash-val key entity-map))
395 (setq number-list (delq number number-list))
397 (elmo-clear-hash-val key entity-map)
398 (elmo-clear-hash-val (modb-standard-entity-id entity) entity-map)
400 (elmo-clear-hash-val key flag-map)
401 (modb-standard-set-message-modified msgdb number)
402 (modb-standard-set-flag-modified msgdb number))
403 (modb-standard-set-number-list-internal msgdb number-list)
404 (modb-standard-set-entity-map-internal msgdb entity-map)
405 (modb-standard-set-flag-map-internal msgdb flag-map)))
407 (luna-define-method elmo-msgdb-sort-entities ((msgdb modb-standard)
408 predicate &optional app-data)
409 (message "Sorting...")
410 (let ((numbers (modb-standard-number-list-internal msgdb)))
411 (modb-standard-set-number-list-internal
413 (sort numbers (lambda (a b)
415 (elmo-msgdb-message-entity msgdb a)
416 (elmo-msgdb-message-entity msgdb b)
418 (message "Sorting...done")
421 (luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key)
422 (let ((ret (elmo-get-hash-val
423 (cond ((stringp key) key)
424 ((numberp key) (modb-standard-key key)))
425 (modb-standard-entity-map-internal msgdb))))
426 (if (eq 'autoload (car-safe ret))
427 (when modb-standard-divide-number
428 (modb-standard-load-entity
430 (elmo-msgdb-location msgdb)
431 (/ (nth 1 ret) modb-standard-divide-number))
433 (cond ((stringp key) key)
434 ((numberp key) (modb-standard-key key)))
435 (modb-standard-entity-map-internal msgdb)))
439 (product-provide (provide 'modb-standard) (require 'elmo-version))
441 ;;; modb-standard.el ends here