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 (defcustom modb-standard-economize-entity-size t
44 "*Economize message entity size.
45 When non-nil, redundunt message-id string are not saved."
49 (defvar modb-standard-entity-filename "entity"
50 "Message entity database.")
52 (defvar modb-standard-flag-filename "flag"
53 "Message number <=> Flag status database.")
55 (defvar modb-standard-msgid-filename "msgid"
56 "Message number <=> Message-Id database.")
59 (luna-define-class modb-standard (modb-generic)
60 (number-list ; sorted list of message numbers.
61 entity-map ; number, msg-id -> entity mapping.
62 flag-map ; number -> flag-list mapping
63 flag-count ; list of (FLAG . COUNT)
65 (luna-define-internal-accessors 'modb-standard))
67 ;; for internal use only
68 (defsubst modb-standard-key (number)
69 (concat "#" (number-to-string number)))
71 (defsubst modb-standard-entity-id (entity)
72 (if (eq 'autoload (car-safe entity))
74 (elmo-msgdb-message-entity-field
75 (elmo-message-entity-handler entity)
78 (defsubst modb-standard-entity-map (modb)
79 (or (modb-standard-entity-map-internal modb)
80 (modb-standard-set-entity-map-internal
82 (elmo-make-hash (elmo-msgdb-length modb)))))
84 (defsubst modb-standard-flag-map (modb)
85 (or (modb-standard-flag-map-internal modb)
86 (modb-standard-set-flag-map-internal
88 (elmo-make-hash (elmo-msgdb-length modb)))))
90 (defsubst modb-standard-set-message-modified (modb number)
91 (if modb-standard-divide-number
92 (let ((section (/ number modb-standard-divide-number))
93 (modified (modb-generic-message-modified-internal modb)))
94 (unless (memq section modified)
95 (modb-generic-set-message-modified-internal
96 modb (cons section modified))))
97 (modb-generic-set-message-modified-internal modb t)))
99 (defsubst modb-standard-set-flag-modified (modb number)
100 (modb-generic-set-flag-modified-internal modb t))
102 (defsubst modb-standard-message-flags (modb number)
103 (cdr (elmo-get-hash-val (modb-standard-key number)
104 (modb-standard-flag-map-internal modb))))
106 (defsubst modb-standard-match-flags (check-flags flags)
109 (when (memq (car check-flags) flags)
111 (setq check-flags (cdr check-flags)))))
113 (defsubst modb-standard-countup-flags (modb flags &optional delta)
114 (let ((flag-count (modb-standard-flag-count-internal modb))
118 (if (setq elem (assq flag flag-count))
119 (setcdr elem (+ (cdr elem) delta))
120 (setq flag-count (cons (cons flag delta) flag-count))))
121 (modb-standard-set-flag-count-internal modb flag-count)))
123 ;; save and load functions
124 (defun modb-standard-load-msgid (modb path)
125 (let* ((alist (elmo-object-load
126 (expand-file-name modb-standard-msgid-filename path)))
127 (table (or (modb-standard-entity-map-internal modb)
128 (elmo-make-hash (length alist))))
131 (setq info (cons 'autoload pair))
132 (elmo-set-hash-val (modb-standard-key (car pair)) info table)
133 (elmo-set-hash-val (cdr pair) info table)
134 (setq numbers (cons (car pair) numbers)))
135 (modb-standard-set-number-list-internal modb (nreverse numbers))
136 (modb-standard-set-entity-map-internal modb table)))
138 (defun modb-standard-save-msgid (modb path)
139 (let ((table (modb-standard-entity-map-internal modb))
141 (dolist (number (modb-standard-number-list-internal modb))
142 (setq entity (elmo-get-hash-val (modb-standard-key number) table))
143 (setq alist (cons (cons number (modb-standard-entity-id entity))
146 (expand-file-name modb-standard-msgid-filename path)
149 (defun modb-standard-load-flag (modb path)
150 (let ((table (or (modb-standard-flag-map-internal modb)
151 (elmo-make-hash (elmo-msgdb-length modb)))))
152 (dolist (info (elmo-object-load
153 (expand-file-name modb-standard-flag-filename path)))
154 (modb-standard-countup-flags modb (cdr info))
155 (elmo-set-hash-val (modb-standard-key (car info)) info table))
156 (modb-standard-set-flag-map-internal modb table)))
158 (defun modb-standard-save-flag (modb path)
159 (let (table flist info)
160 (when (setq table (modb-standard-flag-map-internal modb))
163 (setq info (symbol-value atom))
165 (setq flist (cons info flist))))
168 (expand-file-name modb-standard-flag-filename path)
171 (defsubst modb-standard-entity-filename (section)
173 (concat modb-standard-entity-filename
175 (number-to-string section))
176 modb-standard-entity-filename))
178 (defsubst modb-standard-loaded-message-id (msgdb number)
179 "Get message-id for autoloaded entity."
180 (let ((ret (elmo-get-hash-val
181 (modb-standard-key number)
182 (modb-standard-entity-map-internal msgdb))))
184 ((and ret (eq (car-safe ret) 'autoload))
185 (cdr (cdr ret))) ; message-id.
186 ((and ret (stringp (car-safe ret)))
191 (elmo-clear-hash-val (modb-standard-key number)
192 (modb-standard-entity-map-internal msgdb))
194 (t (error "Internal error: invalid msgdb status")))))
196 (defun modb-standard-load-entity (modb path &optional section)
197 (let ((table (or (modb-standard-entity-map-internal modb)
198 (elmo-make-hash (elmo-msgdb-length modb))))
200 (dolist (entity (elmo-object-load
202 (modb-standard-entity-filename section)
204 (setq number (elmo-msgdb-message-entity-number
205 (elmo-message-entity-handler entity)
207 msgid (modb-standard-loaded-message-id modb number))
209 (setcar entity msgid)
210 (elmo-set-hash-val msgid entity table)
211 (elmo-set-hash-val (modb-standard-key number) entity table)))
212 (modb-standard-set-entity-map-internal modb table)))
214 (defsubst modb-standard-save-entity-1 (modb path &optional section)
215 (let ((table (modb-standard-entity-map-internal modb))
216 (filename (expand-file-name
217 (modb-standard-entity-filename section) path))
219 (dolist (number (modb-standard-number-list-internal modb))
220 (when (and (or (null section)
221 (= section (/ number modb-standard-divide-number)))
222 (setq entity (elmo-msgdb-message-entity modb number)))
223 (when modb-standard-economize-entity-size
224 (when (stringp (car entity))
225 (setq entity (cons t (cdr entity)))))
226 (setq entities (cons entity entities))))
228 (elmo-object-save filename entities)
229 (ignore-errors (delete-file filename)))))
231 (defun modb-standard-save-entity (modb path)
232 (let ((sections (modb-generic-message-modified-internal modb)))
233 (cond ((listp sections)
234 (dolist (section sections)
235 (modb-standard-save-entity-1 modb path section)))
237 (modb-standard-save-entity-1 modb path)))))
241 (luna-define-method elmo-msgdb-load ((msgdb modb-standard))
242 (let ((inhibit-quit t)
243 (path (elmo-msgdb-location msgdb)))
244 (when (file-exists-p (expand-file-name modb-standard-flag-filename path))
245 (modb-standard-load-msgid msgdb path)
246 (modb-standard-load-flag msgdb path)
247 (unless modb-standard-divide-number
248 (modb-standard-load-entity msgdb path))
251 (luna-define-method elmo-msgdb-save ((msgdb modb-standard))
252 (let ((path (elmo-msgdb-location msgdb))
254 (when (elmo-msgdb-message-modified-p msgdb)
255 (modb-standard-save-msgid msgdb path)
256 (modb-standard-save-entity msgdb path)
257 (modb-generic-set-message-modified-internal msgdb nil))
258 (when (elmo-msgdb-flag-modified-p msgdb)
259 (modb-standard-save-flag msgdb path)
260 (modb-generic-set-flag-modified-internal msgdb nil))))
262 (luna-define-method elmo-msgdb-append :around ((msgdb modb-standard)
264 (when (> (elmo-msgdb-length msgdb-append) 0)
265 (if (eq (luna-class-name msgdb-append) 'modb-standard)
266 (let ((numbers (modb-standard-number-list-internal msgdb-append))
269 (modb-standard-set-number-list-internal
271 (nconc (modb-standard-number-list-internal msgdb)
274 (let ((table (modb-standard-entity-map msgdb))
276 (dolist (number numbers)
277 (setq entity (elmo-msgdb-message-entity msgdb-append number)
278 msg-id (modb-standard-entity-id entity))
279 (if (elmo-get-hash-val msg-id table)
280 (setq duplicates (cons number duplicates))
281 (elmo-set-hash-val msg-id entity table))
282 (elmo-set-hash-val (modb-standard-key number)
286 (let ((table (modb-standard-flag-map msgdb)))
289 (elmo-set-hash-val (symbol-name atom)
292 (modb-standard-flag-map msgdb-append)))
294 (dolist (pair (modb-standard-flag-count-internal msgdb-append))
295 (modb-standard-countup-flags msgdb (list (car pair)) (cdr pair)))
296 ;; modification flags
297 (dolist (number (modb-standard-number-list-internal msgdb-append))
298 (modb-standard-set-message-modified msgdb number)
299 (modb-standard-set-flag-modified msgdb number))
301 (luna-call-next-method))))
303 (luna-define-method elmo-msgdb-clear :after ((msgdb modb-standard))
304 (modb-standard-set-number-list-internal msgdb nil)
305 (modb-standard-set-entity-map-internal msgdb nil)
306 (modb-standard-set-flag-map-internal msgdb nil)
307 (modb-standard-set-flag-count-internal msgdb nil))
309 (luna-define-method elmo-msgdb-length ((msgdb modb-standard))
310 (length (modb-standard-number-list-internal msgdb)))
312 (luna-define-method elmo-msgdb-flag-available-p ((msgdb modb-standard) flag)
315 (luna-define-method elmo-msgdb-flags ((msgdb modb-standard) number)
316 (modb-standard-message-flags msgdb number))
318 (luna-define-method elmo-msgdb-set-flag ((msgdb modb-standard)
322 (elmo-msgdb-unset-flag msgdb number 'unread))
324 (elmo-msgdb-unset-flag msgdb number 'cached))
326 (let ((cur-flags (modb-standard-message-flags msgdb number))
328 (unless (memq flag cur-flags)
329 (setq new-flags (cons flag cur-flags))
330 (setq diff (elmo-list-diff new-flags cur-flags))
331 (modb-standard-countup-flags msgdb (car diff))
332 (modb-standard-countup-flags msgdb (cadr diff) -1)
333 (elmo-set-hash-val (modb-standard-key number)
334 (cons number new-flags)
335 (modb-standard-flag-map msgdb))
336 (modb-standard-set-flag-modified msgdb number))))))
338 (luna-define-method elmo-msgdb-unset-flag ((msgdb modb-standard)
342 (elmo-msgdb-set-flag msgdb number 'unread))
344 (elmo-msgdb-set-flag msgdb number 'cached))
346 (modb-standard-countup-flags msgdb
347 (modb-standard-message-flags msgdb number)
349 (elmo-clear-hash-val (modb-standard-key number)
350 (modb-standard-flag-map msgdb)))
352 (let ((cur-flags (modb-standard-message-flags msgdb number))
354 (when (memq flag cur-flags)
355 (setq new-flags (delq flag (copy-sequence cur-flags)))
356 (setq diff (elmo-list-diff new-flags cur-flags))
357 (modb-standard-countup-flags msgdb (car diff))
358 (modb-standard-countup-flags msgdb (cadr diff) -1)
359 (elmo-set-hash-val (modb-standard-key number)
360 (cons number new-flags)
361 (modb-standard-flag-map msgdb))
362 (modb-standard-set-flag-modified msgdb number))
363 (when (eq flag 'unread)
364 (elmo-msgdb-unset-flag msgdb number 'new))))))
366 (luna-define-method elmo-msgdb-flag-count ((msgdb modb-standard))
367 (modb-standard-flag-count-internal msgdb))
369 (luna-define-method elmo-msgdb-list-messages ((msgdb modb-standard))
371 (modb-standard-number-list-internal msgdb)))
373 (luna-define-method elmo-msgdb-list-flagged ((msgdb modb-standard) flag)
377 (dolist (number (modb-standard-number-list-internal msgdb))
378 (unless (memq 'unread (modb-standard-message-flags msgdb number))
379 (setq matched (cons number matched)))))
381 (dolist (number (modb-standard-number-list-internal msgdb))
382 (unless (memq 'cached (modb-standard-message-flags msgdb number))
383 (setq matched (cons number matched)))))
387 (setq entry (symbol-value atom))
388 (unless (and (eq (length (cdr entry)) 1)
389 (eq (car (cdr entry)) 'cached))
390 ;; If there is a flag other than cached, then the message
392 (setq matched (cons (car entry) matched))))
393 (modb-standard-flag-map msgdb)))
395 (let ((flags (append elmo-digest-flags
396 (elmo-get-global-flags t t))))
399 (setq entry (symbol-value atom))
400 (when (modb-standard-match-flags flags (cdr entry))
401 (setq matched (cons (car entry) matched))))
402 (modb-standard-flag-map msgdb))))
406 (setq entry (symbol-value atom))
407 (when (memq flag (cdr entry))
408 (setq matched (cons (car entry) matched))))
409 (modb-standard-flag-map msgdb))))
412 (luna-define-method elmo-msgdb-search ((msgdb modb-standard)
413 condition &optional numbers)
414 (if (vectorp condition)
415 (let ((key (elmo-filter-key condition))
418 ((and (string= key "flag")
419 (eq (elmo-filter-type condition) 'match))
420 (setq results (elmo-msgdb-list-flagged
422 (intern (elmo-filter-value condition))))
424 (elmo-list-filter numbers results)
426 ((member key '("first" "last"))
427 (let* ((numbers (or numbers
428 (modb-standard-number-list-internal msgdb)))
429 (len (length numbers))
430 (lastp (string= key "last"))
431 (value (string-to-number (elmo-filter-value condition))))
432 (when (eq (elmo-filter-type condition) 'unmatch)
433 (setq lastp (not lastp)
434 value (- len value)))
436 (nthcdr (max (- len value) 0) numbers)
438 (let* ((numbers (copy-sequence numbers))
439 (last (nthcdr (1- value) numbers)))
447 (luna-define-method elmo-msgdb-append-entity ((msgdb modb-standard)
448 entity &optional flags)
450 (let ((number (elmo-msgdb-message-entity-number
451 (elmo-message-entity-handler entity) entity))
452 (msg-id (elmo-msgdb-message-entity-field
453 (elmo-message-entity-handler entity) entity 'message-id))
457 (modb-standard-set-number-list-internal
459 (nconc (modb-standard-number-list-internal msgdb)
462 (let ((table (modb-standard-entity-map msgdb)))
463 (setq duplicate (elmo-get-hash-val msg-id table))
464 (elmo-set-hash-val (modb-standard-key number) entity table)
465 (elmo-set-hash-val msg-id entity table))
466 ;; modification flags
467 (modb-standard-set-message-modified msgdb number)
471 (modb-standard-key number)
473 (modb-standard-flag-map msgdb))
474 (modb-standard-countup-flags msgdb flags)
475 (modb-standard-set-flag-modified msgdb number))
478 (luna-define-method elmo-msgdb-delete-messages ((msgdb modb-standard)
480 (let ((number-list (modb-standard-number-list-internal msgdb))
481 (entity-map (modb-standard-entity-map-internal msgdb))
482 (flag-map (modb-standard-flag-map-internal msgdb))
484 (dolist (number numbers)
485 (setq key (modb-standard-key number)
486 entity (elmo-get-hash-val key entity-map))
489 (setq number-list (delq number number-list))
491 (elmo-clear-hash-val key entity-map)
492 (elmo-clear-hash-val (modb-standard-entity-id entity) entity-map)
493 ;; flag-count (must be BEFORE flag-map)
494 (modb-standard-countup-flags
496 (modb-standard-message-flags msgdb number)
499 (elmo-clear-hash-val key flag-map)
500 (modb-standard-set-message-modified msgdb number)
501 (modb-standard-set-flag-modified msgdb number)))
502 (modb-standard-set-number-list-internal msgdb number-list)
503 (modb-standard-set-entity-map-internal msgdb entity-map)
504 (modb-standard-set-flag-map-internal msgdb flag-map)
507 (luna-define-method elmo-msgdb-sort-entities ((msgdb modb-standard)
508 predicate &optional app-data)
509 (message "Sorting...")
510 (let ((numbers (modb-standard-number-list-internal msgdb)))
511 (modb-standard-set-number-list-internal
513 (sort numbers (lambda (a b)
515 (elmo-msgdb-message-entity msgdb a)
516 (elmo-msgdb-message-entity msgdb b)
518 (message "Sorting...done")
521 (defun modb-standard-message-entity (msgdb key load)
522 (let ((ret (elmo-get-hash-val
524 (modb-standard-entity-map-internal msgdb)))
526 (if (eq 'autoload (car-safe ret))
527 (when (and load modb-standard-divide-number)
528 (modb-standard-load-entity
530 (elmo-msgdb-location msgdb)
531 (/ (nth 1 ret) modb-standard-divide-number))
532 (modb-standard-message-entity msgdb key nil))
535 (luna-define-method elmo-msgdb-message-number ((msgdb modb-standard)
537 (let ((ret (elmo-get-hash-val
539 (modb-standard-entity-map-internal msgdb))))
540 (if (eq 'autoload (car-safe ret))
541 ;; Not loaded yet but can return number.
543 (elmo-message-entity-number ret))))
545 (luna-define-method elmo-msgdb-message-field ((msgdb modb-standard)
547 (let ((ret (elmo-get-hash-val
548 (modb-standard-key number)
549 (modb-standard-entity-map-internal msgdb))))
550 (if (and (eq 'autoload (car-safe ret)) (eq field 'message-id))
551 ;; Not loaded yet but can return message-id
553 (elmo-message-entity-field (elmo-msgdb-message-entity
554 msgdb (modb-standard-key number))
557 (luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key)
559 (modb-standard-message-entity
561 (cond ((stringp key) key)
562 ((numberp key) (modb-standard-key key)))
566 (product-provide (provide 'modb-standard) (require 'elmo-version))
568 ;;; modb-standard.el ends here