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))
37 (defcustom modb-standard-divide-number 500
38 "*Standard modb divide entity number."
39 :type '(choice (const :tag "Not divide" nil)
43 (defvar modb-standard-entity-filename "entity"
44 "Message entity database.")
46 (defvar modb-standard-flag-filename "flag"
47 "Message number <=> Flag status database.")
49 (defvar modb-standard-msgid-filename "msgid"
50 "Message number <=> Message-Id database.")
53 (luna-define-class modb-standard (modb-generic)
54 (number-list ; sorted list of message numbers.
55 entity-map ; number, msg-id -> entity mapping.
56 flag-map ; number -> flag-list mapping
57 flag-count ; list of (FLAG . COUNT)
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)))))
107 (defsubst modb-standard-countup-flags (modb flags &optional delta)
108 (let ((flag-count (modb-standard-flag-count-internal modb))
112 (if (setq elem (assq flag flag-count))
113 (setcdr elem (+ (cdr elem) delta))
114 (setq flag-count (cons (cons flag delta) flag-count))))
115 (modb-standard-set-flag-count-internal modb flag-count)))
117 ;; save and load functions
118 (defun modb-standard-load-msgid (modb path)
119 (let* ((alist (elmo-object-load
120 (expand-file-name modb-standard-msgid-filename path)))
121 (table (or (modb-standard-entity-map-internal modb)
122 (elmo-make-hash (length alist))))
125 (setq info (cons 'autoload pair))
126 (elmo-set-hash-val (modb-standard-key (car pair)) info table)
127 (elmo-set-hash-val (cdr pair) info table)
128 (setq numbers (cons (car pair) numbers)))
129 (modb-standard-set-number-list-internal modb (nreverse numbers))
130 (modb-standard-set-entity-map-internal modb table)))
132 (defun modb-standard-save-msgid (modb path)
133 (let ((table (modb-standard-entity-map-internal modb))
135 (dolist (number (modb-standard-number-list-internal modb))
136 (setq entity (elmo-get-hash-val (modb-standard-key number) table))
137 (setq alist (cons (cons number (modb-standard-entity-id entity))
140 (expand-file-name modb-standard-msgid-filename path)
143 (defun modb-standard-load-flag (modb path)
144 (let ((table (or (modb-standard-flag-map-internal modb)
145 (elmo-make-hash (elmo-msgdb-length modb)))))
146 (dolist (info (elmo-object-load
147 (expand-file-name modb-standard-flag-filename path)))
148 (modb-standard-countup-flags modb (cdr info))
149 (elmo-set-hash-val (modb-standard-key (car info)) info table))
150 (modb-standard-set-flag-map-internal modb table)))
152 (defun modb-standard-save-flag (modb path)
153 (let (table flist info)
154 (when (setq table (modb-standard-flag-map-internal modb))
157 (setq info (symbol-value atom))
159 (setq flist (cons info flist))))
162 (expand-file-name modb-standard-flag-filename path)
165 (defsubst modb-standard-entity-filename (section)
167 (concat modb-standard-entity-filename
169 (number-to-string section))
170 modb-standard-entity-filename))
172 (defun modb-standard-load-entity (modb path &optional section)
173 (let ((table (or (modb-standard-entity-map-internal modb)
174 (elmo-make-hash (elmo-msgdb-length modb)))))
175 (dolist (entity (elmo-object-load
177 (modb-standard-entity-filename section)
179 (elmo-set-hash-val (modb-standard-key
180 (elmo-msgdb-message-entity-number
181 (elmo-message-entity-handler entity)
185 (elmo-set-hash-val (elmo-msgdb-message-entity-field
186 (elmo-message-entity-handler entity)
190 (modb-standard-set-entity-map-internal modb table)))
192 (defsubst modb-standard-save-entity-1 (modb path &optional section)
193 (let ((table (modb-standard-entity-map-internal modb))
194 (filename (expand-file-name
195 (modb-standard-entity-filename section) path))
197 (dolist (number (modb-standard-number-list-internal modb))
198 (when (and (or (null section)
199 (= section (/ number modb-standard-divide-number)))
200 (setq entity (elmo-msgdb-message-entity modb number)))
201 (setq entities (cons entity entities))))
203 (elmo-object-save filename entities)
204 (ignore-errors (delete-file filename)))))
206 (defun modb-standard-save-entity (modb path)
207 (let ((sections (modb-generic-message-modified-internal modb)))
208 (cond ((listp sections)
209 (dolist (section sections)
210 (modb-standard-save-entity-1 modb path section)))
212 (modb-standard-save-entity-1 modb path)))))
216 (luna-define-method elmo-msgdb-load ((msgdb modb-standard))
217 (let ((inhibit-quit t)
218 (path (elmo-msgdb-location msgdb)))
219 (when (file-exists-p (expand-file-name modb-standard-flag-filename path))
220 (modb-standard-load-msgid msgdb path)
221 (modb-standard-load-flag msgdb path)
222 (unless modb-standard-divide-number
223 (modb-standard-load-entity msgdb path))
226 (luna-define-method elmo-msgdb-save ((msgdb modb-standard))
227 (let ((path (elmo-msgdb-location msgdb)))
228 (when (elmo-msgdb-message-modified-p msgdb)
229 (modb-standard-save-msgid msgdb path)
230 (modb-standard-save-entity msgdb path)
231 (modb-generic-set-message-modified-internal msgdb nil))
232 (when (elmo-msgdb-flag-modified-p msgdb)
233 (modb-standard-save-flag msgdb path)
234 (modb-generic-set-flag-modified-internal msgdb nil))))
236 (luna-define-method elmo-msgdb-append :around ((msgdb modb-standard)
238 (when (> (elmo-msgdb-length msgdb-append) 0)
239 (if (eq (luna-class-name msgdb-append) 'modb-standard)
240 (let ((numbers (modb-standard-number-list-internal msgdb-append))
243 (modb-standard-set-number-list-internal
245 (nconc (modb-standard-number-list-internal msgdb)
248 (let ((table (modb-standard-entity-map msgdb))
250 (dolist (number numbers)
251 (setq entity (elmo-msgdb-message-entity msgdb-append number)
252 msg-id (modb-standard-entity-id entity))
253 (if (elmo-get-hash-val msg-id table)
254 (setq duplicates (cons number duplicates))
255 (elmo-set-hash-val msg-id entity table))
256 (elmo-set-hash-val (modb-standard-key number)
260 (let ((table (modb-standard-flag-map msgdb)))
263 (elmo-set-hash-val (symbol-name atom)
266 (modb-standard-flag-map msgdb-append)))
268 (dolist (pair (modb-standard-flag-count-internal msgdb-append))
269 (modb-standard-countup-flags msgdb (list (car pair)) (cdr pair)))
270 ;; modification flags
271 (dolist (number (modb-standard-number-list-internal msgdb-append))
272 (modb-standard-set-message-modified msgdb number)
273 (modb-standard-set-flag-modified msgdb number))
275 (luna-call-next-method))))
277 (luna-define-method elmo-msgdb-clear :after ((msgdb modb-standard))
278 (modb-standard-set-number-list-internal msgdb nil)
279 (modb-standard-set-entity-map-internal msgdb nil)
280 (modb-standard-set-flag-map-internal msgdb nil)
281 (modb-standard-set-flag-count-internal msgdb nil))
283 (luna-define-method elmo-msgdb-length ((msgdb modb-standard))
284 (length (modb-standard-number-list-internal msgdb)))
286 (luna-define-method elmo-msgdb-flags ((msgdb modb-standard) number)
287 (modb-standard-message-flags msgdb number))
289 (luna-define-method elmo-msgdb-set-flag ((msgdb modb-standard)
293 (elmo-msgdb-unset-flag msgdb number 'unread))
295 (elmo-msgdb-unset-flag msgdb number 'cached))
297 (let ((cur-flags (modb-standard-message-flags msgdb number))
299 (unless (memq flag cur-flags)
300 (setq new-flags (cons flag cur-flags))
301 (setq diff (elmo-list-diff new-flags cur-flags))
302 (modb-standard-countup-flags msgdb (car diff))
303 (modb-standard-countup-flags msgdb (cadr diff) -1)
304 (elmo-set-hash-val (modb-standard-key number)
305 (cons number new-flags)
306 (modb-standard-flag-map msgdb))
307 (modb-standard-set-flag-modified msgdb number))))))
309 (luna-define-method elmo-msgdb-unset-flag ((msgdb modb-standard)
313 (elmo-msgdb-set-flag msgdb number 'unread))
315 (elmo-msgdb-set-flag msgdb number 'cached))
317 (modb-standard-countup-flags msgdb
318 (modb-standard-message-flags msgdb number)
320 (elmo-clear-hash-val (modb-standard-key number)
321 (modb-standard-flag-map msgdb)))
323 (let ((cur-flags (modb-standard-message-flags msgdb number))
325 (when (memq flag cur-flags)
326 (setq new-flags (delq flag (copy-sequence cur-flags)))
327 (setq diff (elmo-list-diff new-flags cur-flags))
328 (modb-standard-countup-flags msgdb (car diff))
329 (modb-standard-countup-flags msgdb (cadr diff) -1)
330 (elmo-set-hash-val (modb-standard-key number)
331 (cons number new-flags)
332 (modb-standard-flag-map msgdb))
333 (modb-standard-set-flag-modified msgdb number))
334 (when (eq flag 'unread)
335 (elmo-msgdb-unset-flag msgdb number 'new))))))
337 (luna-define-method elmo-msgdb-flag-count ((msgdb modb-standard))
338 (modb-standard-flag-count-internal msgdb))
340 (luna-define-method elmo-msgdb-list-messages ((msgdb modb-standard))
342 (modb-standard-number-list-internal msgdb)))
344 (luna-define-method elmo-msgdb-list-flagged ((msgdb modb-standard) flag)
345 (let ((flags (case flag
347 (nconc '(unread)(elmo-get-global-flags t t)))
349 (nconc '(unread answered)(elmo-get-global-flags t t)))))
353 (dolist (number (modb-standard-number-list-internal msgdb))
354 (unless (memq 'unread (modb-standard-message-flags msgdb number))
355 (setq matched (cons number matched)))))
359 (setq entry (symbol-value atom))
360 (when (modb-standard-match-flags flags (cdr entry))
361 (setq matched (cons (car entry) matched))))
362 (modb-standard-flag-map msgdb)))
366 (setq entry (symbol-value atom))
367 (when (memq flag (cdr entry))
368 (setq matched (cons (car entry) matched))))
369 (modb-standard-flag-map msgdb))))
372 (luna-define-method elmo-msgdb-search ((msgdb modb-standard)
373 condition &optional numbers)
374 (if (vectorp condition)
375 (let ((key (elmo-filter-key condition))
378 ((and (string= key "flag")
379 (eq (elmo-filter-type condition) 'match))
380 (setq results (elmo-msgdb-list-flagged
382 (intern (elmo-filter-value condition))))
384 (elmo-list-filter numbers results)
386 ((member key '("first" "last"))
387 (let* ((numbers (or numbers
388 (modb-standard-number-list-internal msgdb)))
389 (len (length numbers))
390 (lastp (string= key "last"))
391 (value (string-to-number (elmo-filter-value condition))))
392 (when (eq (elmo-filter-type condition) 'unmatch)
393 (setq lastp (not lastp)
394 value (- len value)))
396 (nthcdr (max (- len value) 0) numbers)
398 (let* ((numbers (copy-sequence numbers))
399 (last (nthcdr (1- value) numbers)))
407 (luna-define-method elmo-msgdb-append-entity ((msgdb modb-standard)
408 entity &optional flags)
410 (let ((number (elmo-msgdb-message-entity-number
411 (elmo-message-entity-handler entity) entity))
412 (msg-id (elmo-msgdb-message-entity-field
413 (elmo-message-entity-handler entity) entity 'message-id))
417 (modb-standard-set-number-list-internal
419 (nconc (modb-standard-number-list-internal msgdb)
422 (let ((table (modb-standard-entity-map msgdb)))
423 (setq duplicate (elmo-get-hash-val msg-id table))
424 (elmo-set-hash-val (modb-standard-key number) entity table)
425 (elmo-set-hash-val msg-id entity table))
426 ;; modification flags
427 (modb-standard-set-message-modified msgdb number)
431 (modb-standard-key number)
433 (modb-standard-flag-map msgdb))
434 (modb-standard-countup-flags msgdb flags)
435 (modb-standard-set-flag-modified msgdb number))
438 (luna-define-method elmo-msgdb-delete-messages ((msgdb modb-standard)
440 (let ((number-list (modb-standard-number-list-internal msgdb))
441 (entity-map (modb-standard-entity-map-internal msgdb))
442 (flag-map (modb-standard-flag-map-internal msgdb))
444 (dolist (number numbers)
445 (setq key (modb-standard-key number)
446 entity (elmo-get-hash-val key entity-map))
449 (setq number-list (delq number number-list))
451 (elmo-clear-hash-val key entity-map)
452 (elmo-clear-hash-val (modb-standard-entity-id entity) entity-map)
453 ;; flag-count (must be BEFORE flag-map)
454 (modb-standard-countup-flags
456 (modb-standard-message-flags msgdb number)
459 (elmo-clear-hash-val key flag-map)
460 (modb-standard-set-message-modified msgdb number)
461 (modb-standard-set-flag-modified msgdb number)))
462 (modb-standard-set-number-list-internal msgdb number-list)
463 (modb-standard-set-entity-map-internal msgdb entity-map)
464 (modb-standard-set-flag-map-internal msgdb flag-map)
467 (luna-define-method elmo-msgdb-sort-entities ((msgdb modb-standard)
468 predicate &optional app-data)
469 (message "Sorting...")
470 (let ((numbers (modb-standard-number-list-internal msgdb)))
471 (modb-standard-set-number-list-internal
473 (sort numbers (lambda (a b)
475 (elmo-msgdb-message-entity msgdb a)
476 (elmo-msgdb-message-entity msgdb b)
478 (message "Sorting...done")
481 (defun modb-standard-message-entity (msgdb key load)
482 (let ((ret (elmo-get-hash-val
484 (modb-standard-entity-map-internal msgdb))))
485 (if (and (eq 'autoload (car-safe ret)) load)
486 (when modb-standard-divide-number
487 (modb-standard-load-entity
489 (elmo-msgdb-location msgdb)
490 (/ (nth 1 ret) modb-standard-divide-number))
491 (modb-standard-message-entity msgdb key nil))
494 (luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key)
496 (modb-standard-message-entity
498 (cond ((stringp key) key)
499 ((numberp key) (modb-standard-key key)))
503 (product-provide (provide 'modb-standard) (require 'elmo-version))
505 ;;; modb-standard.el ends here