1 ;;; modb-legacy.el --- Legacy 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.
33 (eval-when-compile (require 'cl
))
41 (defconst modb-legacy-new-mark
"N"
42 "Mark for new message.")
44 (defconst modb-legacy-unread-uncached-mark
"U"
45 "Mark for unread and uncached message.")
47 (defconst modb-legacy-unread-cached-mark
"!"
48 "Mark for unread but already cached message.")
50 (defconst modb-legacy-read-uncached-mark
"u"
51 "Mark for read but uncached message.")
53 (defconst modb-legacy-answered-cached-mark
"&"
54 "Mark for answered and cached message.")
56 (defconst modb-legacy-answered-uncached-mark
"A"
57 "Mark for answered but uncached message.")
59 (defconst modb-legacy-important-mark
"$"
60 "Mark for important message.")
62 (defconst modb-legacy-flag-list
63 '(new unread important answered cached read uncached
)
64 "A list of flag symbol which is supported by legacy msgdb.")
67 (luna-define-class modb-legacy
(modb-generic)
68 (overview number-alist mark-alist index
))
69 (luna-define-internal-accessors 'modb-legacy
))
71 ;; for internal use only
72 (defsubst elmo-msgdb-get-overview
(msgdb)
73 (modb-legacy-overview-internal msgdb
))
75 (defsubst elmo-msgdb-get-number-alist
(msgdb)
76 (modb-legacy-number-alist-internal msgdb
))
78 (defsubst elmo-msgdb-get-mark-alist
(msgdb)
79 (modb-legacy-mark-alist-internal msgdb
))
81 (defsubst elmo-msgdb-get-index
(msgdb)
82 (modb-legacy-index-internal msgdb
))
84 (defsubst elmo-msgdb-get-entity-hashtb
(msgdb)
85 (car (modb-legacy-index-internal msgdb
)))
87 (defsubst elmo-msgdb-get-mark-hashtb
(msgdb)
88 (cdr (modb-legacy-index-internal msgdb
)))
90 (defsubst elmo-msgdb-get-path
(msgdb)
91 (elmo-msgdb-location msgdb
))
93 (defsubst elmo-msgdb-set-overview
(msgdb overview
)
94 (modb-legacy-set-overview-internal msgdb overview
))
96 (defsubst elmo-msgdb-set-number-alist
(msgdb number-alist
)
97 (modb-legacy-set-number-alist-internal msgdb number-alist
))
99 (defsubst elmo-msgdb-set-mark-alist
(msgdb mark-alist
)
100 (modb-legacy-set-mark-alist-internal msgdb mark-alist
))
102 (defsubst elmo-msgdb-set-index
(msgdb index
)
103 (modb-legacy-set-index-internal msgdb index
))
105 (defsubst elmo-msgdb-set-path
(msgdb path
)
106 (modb-generic-set-location-internal msgdb path
))
109 ;; Internal use only (obsolete interface)
111 (defsubst elmo-msgdb-overview-entity-get-id-internal
(entity)
112 (and entity
(car entity
)))
114 (defsubst elmo-msgdb-overview-entity-get-number-internal
(entity)
115 (and entity
(aref (cdr entity
) 0)))
118 (defun elmo-msgdb-number-load (dir)
120 (expand-file-name elmo-msgdb-number-filename dir
)))
122 (defun elmo-msgdb-overview-load (dir)
124 (expand-file-name elmo-msgdb-overview-filename dir
)))
126 (defun elmo-msgdb-mark-load (dir)
128 (expand-file-name elmo-msgdb-mark-filename dir
)))
130 (defun elmo-msgdb-number-save (dir obj
)
132 (expand-file-name elmo-msgdb-number-filename dir
)
135 (defun elmo-msgdb-mark-save (dir obj
)
137 (expand-file-name elmo-msgdb-mark-filename dir
)
140 (defsubst elmo-msgdb-overview-save
(dir overview
)
142 (expand-file-name elmo-msgdb-overview-filename dir
)
147 (defsubst modb-legacy-supported-flag-p
(flag)
148 (memq flag modb-legacy-flag-list
))
150 (defvar modb-legacy-unread-marks-internal nil
)
151 (defsubst modb-legacy-unread-marks
()
152 "Return an unread mark list"
153 (or modb-legacy-unread-marks-internal
154 (setq modb-legacy-unread-marks-internal
155 (list modb-legacy-new-mark
156 modb-legacy-unread-uncached-mark
157 modb-legacy-unread-cached-mark
))))
159 (defvar modb-legacy-answered-marks-internal nil
)
160 (defsubst modb-legacy-answered-marks
()
161 "Return an answered mark list"
162 (or modb-legacy-answered-marks-internal
163 (setq modb-legacy-answered-marks-internal
164 (list modb-legacy-answered-cached-mark
165 modb-legacy-answered-uncached-mark
))))
167 (defvar modb-legacy-uncached-marks-internal nil
)
168 (defsubst modb-legacy-uncached-marks
()
169 (or modb-legacy-uncached-marks-internal
170 (setq modb-legacy-uncached-marks-internal
171 (list modb-legacy-new-mark
172 modb-legacy-answered-uncached-mark
173 modb-legacy-unread-uncached-mark
174 modb-legacy-read-uncached-mark
))))
176 (defsubst modb-legacy-mark-to-flags
(mark)
178 (and (string= mark modb-legacy-new-mark
)
180 (and (string= mark modb-legacy-important-mark
)
182 (and (member mark
(modb-legacy-unread-marks))
184 (and (member mark
(modb-legacy-answered-marks))
186 (and (not (member mark
(modb-legacy-uncached-marks)))
189 (defsubst modb-legacy-flags-to-mark
(flags)
190 (cond ((memq 'new flags
)
191 modb-legacy-new-mark
)
192 ((memq 'important flags
)
193 modb-legacy-important-mark
)
194 ((memq 'answered flags
)
195 (if (memq 'cached flags
)
196 modb-legacy-answered-cached-mark
197 modb-legacy-answered-uncached-mark
))
198 ((memq 'unread flags
)
199 (if (memq 'cached flags
)
200 modb-legacy-unread-cached-mark
201 modb-legacy-unread-uncached-mark
))
203 (if (memq 'cached flags
)
205 modb-legacy-read-uncached-mark
))))
207 (defsubst elmo-msgdb-get-mark
(msgdb number
)
208 "Get mark string from MSGDB which corresponds to the message with NUMBER."
209 (cadr (elmo-get-hash-val (format "#%d" number
)
210 (elmo-msgdb-get-mark-hashtb msgdb
))))
212 (defsubst elmo-msgdb-set-mark
(msgdb number mark
)
213 "Set MARK of the message with NUMBER in the MSGDB.
214 if MARK is nil, mark is removed."
215 (let ((elem (elmo-get-hash-val (format "#%d" number
)
216 (elmo-msgdb-get-mark-hashtb msgdb
))))
219 ;; Set mark of the elem
220 (setcar (cdr elem
) mark
)
221 ;; Delete elem from mark-alist
222 (elmo-msgdb-set-mark-alist
224 (delq elem
(elmo-msgdb-get-mark-alist msgdb
)))
225 (elmo-clear-hash-val (format "#%d" number
)
226 (elmo-msgdb-get-mark-hashtb msgdb
)))
228 ;; Append new element.
229 (elmo-msgdb-set-mark-alist
232 (elmo-msgdb-get-mark-alist msgdb
)
233 (list (setq elem
(list number mark
)))))
234 (elmo-set-hash-val (format "#%d" number
) elem
235 (elmo-msgdb-get-mark-hashtb msgdb
))))
236 (modb-generic-set-flag-modified-internal msgdb t
)
240 (defun elmo-msgdb-make-index (msgdb &optional overview mark-alist
)
241 "Append OVERVIEW and MARK-ALIST to the index of MSGDB.
242 If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB.
243 Return a list of message numbers which have duplicated message-ids."
245 (let* ((overview (or overview
(elmo-msgdb-get-overview msgdb
)))
246 (mark-alist (or mark-alist
(elmo-msgdb-get-mark-alist msgdb
)))
247 (index (elmo-msgdb-get-index msgdb
))
248 (ehash (or (car index
) ;; append
249 (elmo-make-hash (length overview
))))
250 (mhash (or (cdr index
) ;; append
251 (elmo-make-hash (length overview
))))
255 (if (elmo-get-hash-val (caar overview
) ehash
) ; duplicated.
256 (setq duplicates
(cons
257 (elmo-msgdb-overview-entity-get-number-internal
261 (elmo-set-hash-val (caar overview
) (car overview
) ehash
))
265 (elmo-msgdb-overview-entity-get-number-internal
267 (car overview
) ehash
)
268 (setq overview
(cdr overview
)))
272 (format "#%d" (car (car mark-alist
)))
273 (car mark-alist
) mhash
)
274 (setq mark-alist
(cdr mark-alist
)))
275 (setq index
(or index
(cons ehash mhash
)))
276 (elmo-msgdb-set-index msgdb index
)
279 (defun elmo-msgdb-clear-index (msgdb entity
)
280 (let ((ehash (elmo-msgdb-get-entity-hashtb msgdb
))
281 (mhash (elmo-msgdb-get-mark-hashtb msgdb
))
283 (when (and entity ehash
)
284 (and (setq number
(elmo-msgdb-overview-entity-get-number-internal
286 (elmo-clear-hash-val (format "#%d" number
) ehash
))
287 (and (car entity
) ;; message-id
288 (elmo-clear-hash-val (car entity
) ehash
)))
289 (when (and entity mhash
)
290 (and (setq number
(elmo-msgdb-overview-entity-get-number-internal
292 (elmo-clear-hash-val (format "#%d" number
) mhash
)))))
296 (luna-define-method elmo-msgdb-load
((msgdb modb-legacy
))
297 (let ((inhibit-quit t
)
298 (path (elmo-msgdb-location msgdb
)))
299 (when (file-exists-p (expand-file-name elmo-msgdb-mark-filename path
))
300 (modb-legacy-set-overview-internal
302 (elmo-msgdb-overview-load path
))
303 (modb-legacy-set-number-alist-internal
305 (elmo-msgdb-number-load path
))
306 (modb-legacy-set-mark-alist-internal
308 (elmo-msgdb-mark-load path
))
309 (elmo-msgdb-make-index msgdb
)
312 (luna-define-method elmo-msgdb-save
((msgdb modb-legacy
))
313 (let ((path (elmo-msgdb-location msgdb
)))
314 (when (elmo-msgdb-message-modified-p msgdb
)
315 (elmo-msgdb-overview-save
317 (modb-legacy-overview-internal msgdb
))
318 (elmo-msgdb-number-save
320 (modb-legacy-number-alist-internal msgdb
))
321 (modb-generic-set-message-modified-internal msgdb nil
))
322 (when (elmo-msgdb-flag-modified-p msgdb
)
323 (elmo-msgdb-mark-save
325 (modb-legacy-mark-alist-internal msgdb
))
326 (modb-generic-set-flag-modified-internal msgdb nil
))))
328 (luna-define-method elmo-msgdb-append
:around
((msgdb modb-legacy
)
330 (if (eq (luna-class-name msgdb-append
)
333 (elmo-msgdb-set-overview
335 (nconc (elmo-msgdb-get-overview msgdb
)
336 (elmo-msgdb-get-overview msgdb-append
)))
337 (elmo-msgdb-set-number-alist
339 (nconc (elmo-msgdb-get-number-alist msgdb
)
340 (elmo-msgdb-get-number-alist msgdb-append
)))
341 (elmo-msgdb-set-mark-alist
343 (nconc (elmo-msgdb-get-mark-alist msgdb
)
344 (elmo-msgdb-get-mark-alist msgdb-append
)))
345 (setq duplicates
(elmo-msgdb-make-index
347 (elmo-msgdb-get-overview msgdb-append
)
348 (elmo-msgdb-get-mark-alist msgdb-append
)))
351 (or (elmo-msgdb-get-path msgdb
)
352 (elmo-msgdb-get-path msgdb-append
)))
353 (modb-generic-set-message-modified-internal msgdb t
)
354 (modb-generic-set-flag-modified-internal msgdb t
)
356 (luna-call-next-method)))
358 (luna-define-method elmo-msgdb-clear
:after
((msgdb modb-legacy
))
359 (elmo-msgdb-set-overview msgdb nil
)
360 (elmo-msgdb-set-number-alist msgdb nil
)
361 (elmo-msgdb-set-mark-alist msgdb nil
)
362 (elmo-msgdb-set-index msgdb nil
))
364 (luna-define-method elmo-msgdb-length
((msgdb modb-legacy
))
365 (length (modb-legacy-overview-internal msgdb
)))
367 (luna-define-method elmo-msgdb-flag-available-p
((msgdb modb-legacy
) flag
)
368 (modb-legacy-supported-flag-p flag
))
370 (luna-define-method elmo-msgdb-flags
((msgdb modb-legacy
) number
)
371 (modb-legacy-mark-to-flags (elmo-msgdb-get-mark msgdb number
)))
373 (luna-define-method elmo-msgdb-set-flag
((msgdb modb-legacy
)
375 (unless (modb-legacy-supported-flag-p flag
)
376 (error "Flag `%s' is not supported by this msgdb type"
377 (capitalize (symbol-name flag
))))
380 (elmo-msgdb-unset-flag msgdb number
'unread
))
382 (elmo-msgdb-unset-flag msgdb number
'cached
))
384 (let* ((cur-mark (elmo-msgdb-get-mark msgdb number
))
385 (flags (modb-legacy-mark-to-flags cur-mark
))
387 (and (memq 'new flags
)
388 (setq flags
(delq 'new flags
)))
389 (or (memq flag flags
)
390 (setq flags
(cons flag flags
)))
391 (when (and (eq flag
'unread
)
392 (memq 'answered flags
))
393 (setq flags
(delq 'answered flags
)))
394 (setq new-mark
(modb-legacy-flags-to-mark flags
))
395 (unless (string= new-mark cur-mark
)
396 (elmo-msgdb-set-mark msgdb number new-mark
))))))
398 (luna-define-method elmo-msgdb-unset-flag
((msgdb modb-legacy
)
400 (unless (or (modb-legacy-supported-flag-p flag
)
402 (error "Flag `%s' is not supported by this msgdb type"
403 (capitalize (symbol-name flag
))))
406 (elmo-msgdb-set-flag msgdb number
'unread
))
408 (elmo-msgdb-set-flag msgdb number
'cached
))
410 (elmo-msgdb-set-mark msgdb number nil
))
412 (let* ((cur-mark (elmo-msgdb-get-mark msgdb number
))
413 (flags (modb-legacy-mark-to-flags cur-mark
))
415 (and (memq 'new flags
)
416 (setq flags
(delq 'new flags
)))
417 (and (memq flag flags
)
418 (setq flags
(delq flag flags
)))
419 (when (and (eq flag
'unread
)
420 (memq 'answered flags
))
421 (setq flags
(delq 'answered flags
)))
422 (setq new-mark
(modb-legacy-flags-to-mark flags
))
423 (unless (string= new-mark cur-mark
)
424 (elmo-msgdb-set-mark msgdb number new-mark
))))))
426 (luna-define-method elmo-msgdb-flag-count
((msgdb modb-legacy
))
430 (dolist (elem (elmo-msgdb-get-mark-alist msgdb
))
432 ((string= (cadr elem
) modb-legacy-new-mark
)
435 ((member (cadr elem
) (modb-legacy-unread-marks))
437 ((member (cadr elem
) (modb-legacy-answered-marks))
439 (list (cons 'new new
)
440 (cons 'unread unread
)
441 (cons 'answered answered
))))
443 (luna-define-method elmo-msgdb-list-messages
((msgdb modb-legacy
))
444 (mapcar 'elmo-msgdb-overview-entity-get-number-internal
445 (elmo-msgdb-get-overview msgdb
)))
447 (luna-define-method elmo-msgdb-list-flagged
((msgdb modb-legacy
) flag
)
448 (let ((case-fold-search nil
)
452 (setq mark-regexp
(regexp-quote modb-legacy-new-mark
)))
454 (setq mark-regexp
(elmo-regexp-opt (modb-legacy-unread-marks))))
456 (setq mark-regexp
(elmo-regexp-opt (modb-legacy-answered-marks))))
458 (setq mark-regexp
(regexp-quote modb-legacy-important-mark
)))
460 (setq mark-regexp
(elmo-regexp-opt (modb-legacy-unread-marks))))
462 (setq mark-regexp
(elmo-regexp-opt
463 (append (modb-legacy-unread-marks)
464 (list modb-legacy-important-mark
)))))
466 (setq mark-regexp
(elmo-regexp-opt
468 (modb-legacy-unread-marks)
469 (modb-legacy-answered-marks)
470 (list modb-legacy-important-mark
))))))
473 (dolist (number (elmo-msgdb-list-messages msgdb
))
474 (let ((mark (elmo-msgdb-get-mark msgdb number
)))
475 (unless (and mark
(string-match mark-regexp mark
))
476 (setq matched
(cons number matched
)))))
477 (dolist (elem (elmo-msgdb-get-mark-alist msgdb
))
478 (if (string-match mark-regexp
(cadr elem
))
479 (setq matched
(cons (car elem
) matched
))))))
482 (luna-define-method elmo-msgdb-search
((msgdb modb-legacy
)
483 condition
&optional numbers
)
484 (if (vectorp condition
)
485 (let ((key (elmo-filter-key condition
))
488 ((and (string= key
"flag")
489 (eq (elmo-filter-type condition
) 'match
))
490 (setq results
(elmo-msgdb-list-flagged
492 (intern (elmo-filter-value condition
))))
494 (elmo-list-filter numbers results
)
496 ((member key
'("first" "last"))
497 (let* ((numbers (or numbers
(elmo-msgdb-list-messages msgdb
)))
498 (len (length numbers
))
499 (lastp (string= key
"last"))
500 (value (string-to-number (elmo-filter-value condition
))))
501 (when (eq (elmo-filter-type condition
) 'unmatch
)
502 (setq lastp
(not lastp
)
503 value
(- len value
)))
505 (nthcdr (max (- len value
) 0) numbers
)
507 (let* ((numbers (copy-sequence numbers
))
508 (last (nthcdr (1- value
) numbers
)))
516 (luna-define-method elmo-msgdb-append-entity
((msgdb modb-legacy
)
517 entity
&optional flags
)
519 (let ((number (elmo-msgdb-overview-entity-get-number-internal entity
))
520 (message-id (elmo-msgdb-overview-entity-get-id-internal entity
))
522 (when (and number message-id
)
523 (elmo-msgdb-set-overview
525 (nconc (elmo-msgdb-get-overview msgdb
)
527 (elmo-msgdb-set-number-alist
529 (nconc (elmo-msgdb-get-number-alist msgdb
)
530 (list (cons number message-id
))))
531 (modb-generic-set-message-modified-internal msgdb t
)
532 (when (setq mark
(modb-legacy-flags-to-mark flags
))
533 (setq cell
(list number mark
))
534 (elmo-msgdb-set-mark-alist
536 (nconc (elmo-msgdb-get-mark-alist msgdb
) (list cell
)))
537 (modb-generic-set-flag-modified-internal msgdb t
))
538 (elmo-msgdb-make-index
541 (and cell
(list cell
)))))))
543 (luna-define-method elmo-msgdb-delete-messages
((msgdb modb-legacy
)
545 (let* ((overview (elmo-msgdb-get-overview msgdb
))
546 (number-alist (elmo-msgdb-get-number-alist msgdb
))
547 (mark-alist (elmo-msgdb-get-mark-alist msgdb
))
548 (index (elmo-msgdb-get-index msgdb
))
550 ;; remove from current database.
551 (dolist (number numbers
)
555 (elmo-msgdb-message-entity msgdb number
))
557 (setq number-alist
(delq (assq number number-alist
) number-alist
))
558 (setq mark-alist
(delq (assq number mark-alist
) mark-alist
))
560 (when index
(elmo-msgdb-clear-index msgdb ov-entity
)))
561 (elmo-msgdb-set-overview msgdb overview
)
562 (elmo-msgdb-set-number-alist msgdb number-alist
)
563 (elmo-msgdb-set-mark-alist msgdb mark-alist
)
564 (elmo-msgdb-set-index msgdb index
)
565 (modb-generic-set-message-modified-internal msgdb t
)
566 (modb-generic-set-flag-modified-internal msgdb t
)
569 (luna-define-method elmo-msgdb-sort-entities
((msgdb modb-legacy
)
570 predicate
&optional app-data
)
571 (message "Sorting...")
572 (let ((overview (elmo-msgdb-get-overview msgdb
)))
573 (elmo-msgdb-set-overview
575 (sort overview
(lambda (a b
) (funcall predicate a b app-data
))))
576 (message "Sorting...done")
579 (luna-define-method elmo-msgdb-message-entity
((msgdb modb-legacy
) key
)
582 (cond ((stringp key
) key
)
583 ((numberp key
) (format "#%d" key
)))
584 (elmo-msgdb-get-entity-hashtb msgdb
))))
587 (product-provide (provide 'modb-legacy
) (require 'elmo-version
))
589 ;;; modb-legacy.el ends here