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-db 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-db entity)
175 (elmo-set-hash-val (elmo-msgdb-message-entity-field
176 (elmo-message-entity-db 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-db entity) entity))
361 (msg-id (elmo-msgdb-message-entity-field
362 (elmo-message-entity-db 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)))
438 ;;; Message entity handling.
439 (defsubst modb-standard-make-message-entity (args)
440 "Make an message entity."
441 (cons (plist-get args :message-id)
442 (vector (plist-get args :number)
443 (plist-get args :references)
444 (plist-get args :from)
445 (plist-get args :subject)
446 (plist-get args :date)
449 (plist-get args :size)
450 (plist-get args :extra))))
452 (luna-define-method elmo-msgdb-make-message-entity ((msgdb modb-standard)
454 (modb-standard-make-message-entity args))
456 (luna-define-method elmo-msgdb-create-message-entity-from-buffer
457 ((msgdb modb-standard) number args)
458 (let ((extras elmo-msgdb-extra-fields)
459 (default-mime-charset default-mime-charset)
460 entity message-id references from subject to cc date
461 extra field-body charset size)
463 (setq entity (modb-standard-make-message-entity args)
464 ;; For compatibility.
465 msgdb (elmo-message-entity-db entity))
466 (elmo-set-buffer-multibyte default-enable-multibyte-characters)
467 (setq message-id (elmo-msgdb-get-message-id-from-buffer))
468 (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
469 (setq charset (intern-soft charset))
470 (setq default-mime-charset charset))
472 (or (elmo-msgdb-get-last-message-id
473 (elmo-field-body "in-reply-to"))
474 (elmo-msgdb-get-last-message-id
475 (elmo-field-body "references")))
476 from (elmo-replace-in-string
477 (elmo-mime-string (or (elmo-field-body "from")
480 subject (elmo-replace-in-string
481 (elmo-mime-string (or (elmo-field-body "subject")
484 date (elmo-field-body "date")
485 to (mapconcat 'identity (elmo-multiple-field-body "to") ",")
486 cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
487 (unless (elmo-msgdb-message-entity-field msgdb entity 'size)
488 (if (setq size (elmo-field-body "content-length"))
489 (setq size (string-to-int size))
492 (if (setq field-body (elmo-field-body (car extras)))
493 (elmo-msgdb-message-entity-set-field
494 msgdb entity (intern (downcase (car extras))) field-body))
495 (setq extras (cdr extras)))
496 (dolist (field '(number message-id references from subject
498 (when (symbol-value field)
499 (elmo-msgdb-message-entity-set-field
500 msgdb entity field (symbol-value field))))
503 ;;; Message entity interface
505 (luna-define-method elmo-msgdb-message-entity-number ((msgdb modb-standard)
507 ;; To be implemented.
510 (luna-define-method elmo-msgdb-message-entity-set-number ((msgdb modb-standard)
513 ;; To be implemented.
516 (luna-define-method elmo-msgdb-message-entity-field ((msgdb modb-standard)
519 ;; To be implemented.
522 (luna-define-method elmo-msgdb-message-entity-set-field ((msgdb modb-standard)
524 ;; To be implemented.
527 (luna-define-method elmo-msgdb-copy-message-entity ((msgdb modb-standard)
529 ;; To be implemented.
532 (luna-define-method elmo-msgdb-match-condition-internal ((msgdb modb-standard)
534 entity flags numbers)
535 ;; To be implemented.
539 (product-provide (provide 'modb-standard) (require 'elmo-version))
541 ;;; modb-standard.el ends here