1 ;;; elmo-msgdb.el -- Message Database for Elmo.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
7 ;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
8 ;; Keywords: mail, net news
10 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
34 (eval-when-compile (require 'cl))
41 (defun elmo-msgdb-expand-path (folder)
42 "Expand msgdb path for FOLDER.
43 FOLDER should be a sring of folder name or folder spec."
44 (convert-standard-filename
45 (let* ((spec (if (stringp folder)
46 (elmo-folder-get-spec folder)
52 (setq fld (elmo-imap4-spec-mailbox spec))
53 (if (string= "inbox" (downcase fld))
55 (if (eq (string-to-char fld) ?/)
56 (setq fld (substring fld 1 (length fld))))
59 (expand-file-name (or (elmo-imap4-spec-username spec) "nobody")
61 (elmo-imap4-spec-hostname spec)
68 (elmo-nntp-spec-group spec)
69 (expand-file-name (or (elmo-nntp-spec-hostname spec) "nowhere")
70 (expand-file-name "nntp"
73 (expand-file-name (elmo-safe-filename (nth 1 spec))
74 (expand-file-name "maildir"
77 (expand-file-name (elmo-safe-filename (nth 1 spec))
78 (expand-file-name "folder"
81 (setq fld (concat "*" (mapconcat 'identity (cdr spec) ",")))
82 (expand-file-name (elmo-safe-filename fld)
83 (expand-file-name "multi"
87 (elmo-replace-msgid-as-filename folder)
88 (expand-file-name "filter"
94 (elmo-replace-in-string
95 (elmo-replace-in-string
96 (elmo-replace-in-string
102 (expand-file-name (concat (symbol-name type) "/"
103 (symbol-name (nth 2 spec)))
107 (elmo-safe-filename (elmo-pop3-spec-username spec))
108 (expand-file-name (elmo-pop3-spec-hostname spec)
112 ((eq type 'localnews)
114 (elmo-replace-in-string (nth 1 spec) "/" ".")
115 (expand-file-name "localnews"
118 (expand-file-name (elmo-safe-filename (concat (symbol-name (nth 1 spec))
120 (expand-file-name "internal"
123 (expand-file-name (elmo-safe-filename (nth 1 spec))
124 (expand-file-name "internal/cache"
126 (t ; local dir or undefined type
128 (setq fld (nth 1 spec))
129 (if (file-name-absolute-p fld)
130 (setq fld (elmo-safe-filename fld)))
131 (expand-file-name fld
132 (expand-file-name (symbol-name type)
133 elmo-msgdb-dir)))))))
135 (defsubst elmo-msgdb-append-element (list element)
137 ;;; (append list (list element))
138 (nconc list (list element))
142 (defsubst elmo-msgdb-get-overview (msgdb)
144 (defsubst elmo-msgdb-get-number-alist (msgdb)
146 (defsubst elmo-msgdb-get-mark-alist (msgdb)
148 (defsubst elmo-msgdb-get-location (msgdb)
150 (defsubst elmo-msgdb-get-overviewht (msgdb)
154 ;; number <-> Message-ID handling
156 (defsubst elmo-msgdb-number-add (alist number id)
157 (let ((ret-val alist))
159 (elmo-msgdb-append-element ret-val (cons number id)))
163 ;; parsistent mark handling
166 (defvar elmo-msgdb-global-mark-alist nil)
168 (defun elmo-msgdb-global-mark-delete (msgid)
169 (let* ((path (expand-file-name
170 elmo-msgdb-global-mark-filename
172 (malist (or elmo-msgdb-global-mark-alist
173 (setq elmo-msgdb-global-mark-alist
174 (elmo-object-load path))))
176 (when (setq match (assoc msgid malist))
177 (setq elmo-msgdb-global-mark-alist
178 (delete match elmo-msgdb-global-mark-alist))
179 (elmo-object-save path elmo-msgdb-global-mark-alist))))
181 (defun elmo-msgdb-global-mark-set (msgid mark)
182 (let* ((path (expand-file-name
183 elmo-msgdb-global-mark-filename
185 (malist (or elmo-msgdb-global-mark-alist
186 (setq elmo-msgdb-global-mark-alist
187 (elmo-object-load path))))
189 (if (setq match (assoc msgid malist))
191 (setq elmo-msgdb-global-mark-alist
192 (nconc elmo-msgdb-global-mark-alist
193 (list (cons msgid mark)))))
194 (elmo-object-save path elmo-msgdb-global-mark-alist)))
196 (defun elmo-msgdb-global-mark-get (msgid)
197 (cdr (assoc msgid (or elmo-msgdb-global-mark-alist
198 (setq elmo-msgdb-global-mark-alist
201 elmo-msgdb-global-mark-filename
202 elmo-msgdb-dir)))))))
205 ;; number <-> location handling
207 (defsubst elmo-msgdb-location-load (dir)
210 elmo-msgdb-location-filename
213 (defsubst elmo-msgdb-location-add (alist number location)
214 (let ((ret-val alist))
216 (elmo-msgdb-append-element ret-val (cons number location)))
219 (defsubst elmo-msgdb-location-save (dir alist)
222 elmo-msgdb-location-filename
225 (defun elmo-list-folder-by-location (spec locations &optional msgdb)
226 (let* ((path (elmo-msgdb-expand-path spec))
227 (location-alist (if msgdb
228 (elmo-msgdb-get-location msgdb)
229 (elmo-msgdb-location-load path)))
230 (locations-in-db (mapcar 'cdr location-alist))
231 result new-locs new-alist deleted-locs i
234 (elmo-delete-if (function
235 (lambda (x) (member x locations-in-db)))
238 (elmo-delete-if (function
239 (lambda (x) (member x locations)))
241 (setq modified new-locs)
242 (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
247 (delq (rassoc x location-alist) location-alist))))
251 (setq new-alist (cons (cons i (car new-locs)) new-alist))
252 (setq new-locs (cdr new-locs)))
253 (setq result (nconc location-alist new-alist))
254 (setq result (sort result (lambda (x y) (< (car x)(car y)))))
255 (if modified (elmo-msgdb-location-save path result))
256 (mapcar 'car result)))
259 ;; persistent mark handling
261 (defun elmo-msgdb-mark-set (alist id mark)
262 (let ((ret-val alist)
264 (setq entity (assq id alist))
267 ;; delete this entity
268 (setq ret-val (delq entity alist))
270 (setcar (cdr entity) mark))
272 (setq ret-val (elmo-msgdb-append-element ret-val
276 (defun elmo-msgdb-mark-append (alist id mark)
278 (setq alist (elmo-msgdb-append-element alist
281 (defun elmo-msgdb-mark-alist-to-seen-list (number-alist mark-alist seen-marks)
282 "Make seen-list from MARK-ALIST."
283 (let ((seen-mark-list (string-to-char-list seen-marks))
286 (if (setq ent (assq (car (car number-alist)) mark-alist))
288 (memq (string-to-char (cadr ent)) seen-mark-list))
289 (setq ret-val (cons (cdr (car number-alist)) ret-val)))
290 (setq ret-val (cons (cdr (car number-alist)) ret-val)))
291 (setq number-alist (cdr number-alist)))
297 (defvar elmo-msgdb-decoded-cache-hashtb nil)
298 (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
300 (defsubst elmo-msgdb-get-decoded-cache (string)
301 (if elmo-use-decoded-cache
302 (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
303 (setq elmo-msgdb-decoded-cache-hashtb
304 (elmo-make-hash 2048))))
306 (or (elmo-get-hash-val string hashtb)
311 (decode-mime-charset-string string elmo-mime-charset))
314 (decode-mime-charset-string string elmo-mime-charset)))
320 (defsubst elmo-msgdb-get-field-value (field-name beg end buffer)
324 (narrow-to-region beg end)
325 (elmo-field-body field-name))))
327 (defun elmo-multiple-field-body (name &optional boundary)
330 (std11-narrow-to-header boundary)
331 (goto-char (point-min))
332 (let ((case-fold-search t)
334 (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
337 (list (buffer-substring-no-properties
338 (match-end 0) (std11-field-end))))))
341 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
342 "Return list of each field-bodies of FIELD-NAMES of the message header
343 in current buffer. If BOUNDARY is not nil, it is used as message
347 (std11-narrow-to-header boundary)
348 (let* ((case-fold-search t)
350 field-name field-body)
351 (while (setq field-name (car s-rest))
352 (goto-char (point-min))
353 (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
356 (list (buffer-substring-no-properties
357 (match-end 0) (std11-field-end))))))
358 (setq s-rest (cdr s-rest)))
361 (defsubst elmo-msgdb-remove-field-string (string)
362 (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
363 (substring string (match-end 0))
366 (defsubst elmo-msgdb-get-last-message-id (string)
372 (goto-char (point-max))
373 (when (search-backward "<" nil t)
375 (if (search-forward ">" nil t)
376 (elmo-replace-in-string
377 (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
379 (defun elmo-msgdb-number-load (dir)
381 (expand-file-name elmo-msgdb-number-filename dir)))
383 (defun elmo-msgdb-overview-load (dir)
385 (expand-file-name elmo-msgdb-overview-filename dir)))
387 (defun elmo-msgdb-mark-load (dir)
389 (expand-file-name elmo-msgdb-mark-filename dir)))
391 (defsubst elmo-msgdb-seen-load (dir)
392 (elmo-object-load (expand-file-name
393 elmo-msgdb-seen-filename
396 (defun elmo-msgdb-number-save (dir obj)
398 (expand-file-name elmo-msgdb-number-filename dir)
401 (defun elmo-msgdb-mark-save (dir obj)
403 (expand-file-name elmo-msgdb-mark-filename dir)
406 (defsubst elmo-msgdb-seen-save (dir obj)
408 (expand-file-name elmo-msgdb-seen-filename dir)
411 (defsubst elmo-msgdb-overview-save (dir overview)
413 (expand-file-name elmo-msgdb-overview-filename dir)
416 (defun elmo-msgdb-search-internal-primitive (condition entity number-list)
417 (let ((key (elmo-filter-key condition))
420 ((string= key "last")
421 (setq result (<= (length (memq
422 (elmo-msgdb-overview-entity-get-number entity)
424 (string-to-int (elmo-filter-value condition)))))
425 ((string= key "first")
429 (elmo-msgdb-overview-entity-get-number entity)
431 (string-to-int (elmo-filter-value condition)))))
432 ((string= key "from")
433 (setq result (string-match
434 (elmo-filter-value condition)
435 (elmo-msgdb-overview-entity-get-from entity))))
436 ((string= key "subject")
437 (setq result (string-match
438 (elmo-filter-value condition)
439 (elmo-msgdb-overview-entity-get-subject entity))))
441 (setq result (string-match
442 (elmo-filter-value condition)
443 (elmo-msgdb-overview-entity-get-to entity))))
445 (setq result (string-match
446 (elmo-filter-value condition)
447 (elmo-msgdb-overview-entity-get-cc entity))))
448 ((or (string= key "since")
449 (string= key "before"))
450 (let ((res (string< (timezone-make-date-sortable
451 (elmo-msgdb-overview-entity-get-date entity))
452 (elmo-date-make-sortable-string
453 (elmo-date-get-datevec
454 (elmo-filter-value condition))))))
455 (setq result (if (string= key "before") res (not res)))))
456 ((member key elmo-msgdb-extra-fields)
457 (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
459 (setq result (string-match
460 (elmo-filter-value condition)
462 (if (eq (elmo-filter-type condition) 'unmatch)
463 (setq result (not result)))
466 (defun elmo-msgdb-search-internal (condition entity number-list)
469 (elmo-msgdb-search-internal-primitive condition entity number-list))
470 ((eq (car condition) 'and)
471 (and (elmo-msgdb-search-internal-primitive
472 (nth 1 condition) entity number-list)
473 (elmo-msgdb-search-internal-primitive
474 (nth 2 condition) entity number-list)))
475 ((eq (car condition) 'or)
476 (or (elmo-msgdb-search-internal-primitive
477 (nth 1 condition) entity number-list)
478 (elmo-msgdb-search-internal-primitive
479 (nth 2 condition) entity number-list)))))
481 (defun elmo-msgdb-delete-msgs (folder msgs msgdb &optional reserve-cache)
482 "Delete MSGS from FOLDER in MSGDB.
483 content of MSGDB is changed."
485 (let* ((msg-list msgs)
486 (dir (elmo-msgdb-expand-path folder))
487 (overview (or (car msgdb)
488 (elmo-msgdb-overview-load dir)))
489 (number-alist (or (cadr msgdb)
490 (elmo-msgdb-number-load dir)))
491 (mark-alist (or (caddr msgdb)
492 (elmo-msgdb-mark-load dir)))
493 (loc-alist (or (elmo-msgdb-get-location msgdb)
494 (elmo-msgdb-location-load dir)))
495 (hashtb (or (elmo-msgdb-get-overviewht msgdb)
496 (elmo-msgdb-make-overview-hashtb overview)))
497 (newmsgdb (list overview number-alist mark-alist (nth 3 msgdb) hashtb))
498 ov-entity message-id)
499 ;; remove from current database.
501 (setq message-id (cdr (assq (car msg-list) number-alist)))
502 (if (and (not reserve-cache) message-id)
503 (elmo-cache-delete message-id
504 folder (car msg-list)))
505 ;;; This is no good!!!!
506 ;;; (setq overview (delete (assoc message-id overview) overview))
510 (elmo-msgdb-overview-get-entity (car msg-list) newmsgdb))
512 (when (and elmo-use-overview-hashtb hashtb)
513 (elmo-msgdb-clear-overview-hashtb ov-entity hashtb))
515 (delq (assq (car msg-list) number-alist) number-alist))
516 (setq mark-alist (delq (assq (car msg-list) mark-alist) mark-alist))
517 (setq loc-alist (delq (assq (car msg-list) loc-alist) loc-alist))
518 ;; XXX Should consider when folder is not persistent.
519 ;; (elmo-msgdb-location-save dir loc-alist)
520 (setq msg-list (cdr msg-list)))
521 (setcar msgdb overview)
522 (setcar (cdr msgdb) number-alist)
523 (setcar (cddr msgdb) mark-alist)
524 (setcar (nthcdr 4 msgdb) hashtb))
527 (defsubst elmo-msgdb-set-overview (msgdb overview)
528 (setcar msgdb overview))
530 (defsubst elmo-msgdb-set-number-alist (msgdb number-alist)
531 (setcar (cdr msgdb) number-alist))
533 (defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
534 (setcar (cddr msgdb) mark-alist))
536 (defsubst elmo-msgdb-overview-entity-get-references (entity)
537 (and entity (aref (cdr entity) 1)))
539 ;; entity -> parent-entity
540 (defsubst elmo-msgdb-overview-get-parent-entity (entity database)
541 (setq entity (elmo-msgdb-overview-entity-get-references entity))
542 ;; entity is parent-id.
543 (and entity (assoc entity database)))
545 (defsubst elmo-msgdb-overview-entity-get-number (entity)
546 (and entity (aref (cdr entity) 0)))
548 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
549 (and entity (aref (cdr entity) 2)))
551 (defsubst elmo-msgdb-overview-entity-get-from (entity)
553 (aref (cdr entity) 2)
554 (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
556 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
557 (and entity (aset (cdr entity) 0 number))
559 ;;;(setcar (cadr entity) number) entity)
561 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
562 (and entity (aset (cdr entity) 2 from))
565 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
567 (aref (cdr entity) 3)
568 (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
570 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
571 (and entity (aref (cdr entity) 3)))
573 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
574 (and entity (aset (cdr entity) 3 subject))
577 (defsubst elmo-msgdb-overview-entity-get-date (entity)
578 (and entity (aref (cdr entity) 4)))
580 (defsubst elmo-msgdb-overview-entity-get-to (entity)
581 (and entity (aref (cdr entity) 5)))
583 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
584 (and entity (aref (cdr entity) 6)))
586 (defsubst elmo-msgdb-overview-entity-get-size (entity)
587 (and entity (aref (cdr entity) 7)))
589 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
590 (and entity (aset (cdr entity) 7 size))
593 (defsubst elmo-msgdb-overview-entity-get-id (entity)
594 (and entity (car entity)))
596 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
597 (let ((extra (and entity (aref (cdr entity) 8))))
599 (cdr (assoc field-name extra)))))
601 (defun elmo-msgdb-overview-get-entity-by-number (database number)
606 (if (eq (elmo-msgdb-overview-entity-get-number (car db)) number)
607 (setq entity (car db)
612 (defun elmo-msgdb-overview-get-entity (id msgdb)
614 (let ((ovht (elmo-msgdb-get-overviewht msgdb)))
615 (if ovht ;; use overview hash
616 (if (stringp id) ;; ID is message-id
617 (elmo-get-hash-val id ovht)
618 (elmo-get-hash-val (format "#%d" id) ovht))
619 (let* ((overview (elmo-msgdb-get-overview msgdb))
620 (number-alist (elmo-msgdb-get-number-alist msgdb))
621 (message-id (if (stringp id)
622 id ;; ID is message-id
623 (cdr (assq id number-alist))))
626 (assoc message-id overview)
627 ;; ID is number. message-id is nil or no exists in number-alist.
628 (elmo-msgdb-overview-get-entity-by-number overview id)))))))
631 ;; deleted message handling
633 (defun elmo-msgdb-killed-list-load (dir)
635 (expand-file-name elmo-msgdb-killed-filename dir)
638 (defun elmo-msgdb-killed-list-save (dir killed-list)
640 (expand-file-name elmo-msgdb-killed-filename dir)
643 (defun elmo-msgdb-killed-message-p (killed-list msg)
644 (elmo-number-set-member msg killed-list))
646 (defun elmo-msgdb-set-as-killed (killed-list msg)
647 (elmo-number-set-append killed-list msg))
649 (defun elmo-msgdb-append-to-killed-list (folder msgs)
650 (let ((dir (elmo-msgdb-expand-path folder)))
651 (elmo-msgdb-killed-list-save
653 (elmo-number-set-append-list
654 (elmo-msgdb-killed-list-load dir)
657 (defun elmo-msgdb-killed-list-length (killed-list)
658 (let ((killed killed-list)
661 (if (consp (car killed))
662 (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
663 (setq ret-val (+ ret-val 1)))
664 (setq killed (cdr killed)))
667 (defun elmo-living-messages (messages killed-list)
670 (mapcar (lambda (number)
671 (unless (elmo-number-set-member number killed-list)
676 (defun elmo-msgdb-finfo-load ()
677 (elmo-object-load (expand-file-name
678 elmo-msgdb-finfo-filename
680 elmo-mime-charset t))
682 (defun elmo-msgdb-finfo-save (finfo)
683 (elmo-object-save (expand-file-name
684 elmo-msgdb-finfo-filename
686 finfo elmo-mime-charset))
688 (defun elmo-msgdb-flist-load (folder)
689 (let ((flist-file (expand-file-name
690 elmo-msgdb-flist-filename
691 (elmo-msgdb-expand-path (list 'folder folder)))))
692 (elmo-object-load flist-file nil t)))
694 (defun elmo-msgdb-flist-save (folder flist)
695 (let ((flist-file (expand-file-name
696 elmo-msgdb-flist-filename
697 (elmo-msgdb-expand-path (list 'folder folder)))))
698 (elmo-object-save flist-file flist)))
700 (defun elmo-crosspost-alist-load ()
701 (elmo-object-load (expand-file-name
702 elmo-crosspost-alist-filename
706 (defun elmo-crosspost-alist-save (alist)
707 (elmo-object-save (expand-file-name
708 elmo-crosspost-alist-filename
712 (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
713 "Create overview entity from current buffer.
714 Header region is supposed to be narrowed."
716 (let ((extras elmo-msgdb-extra-fields)
717 message-id references from subject to cc date
719 (elmo-set-buffer-multibyte default-enable-multibyte-characters)
720 (setq message-id (elmo-field-body "message-id"))
722 (or (elmo-msgdb-get-last-message-id
723 (elmo-field-body "in-reply-to"))
724 (elmo-msgdb-get-last-message-id
725 (elmo-field-body "references"))))
726 (setq from (elmo-mime-string (elmo-delete-char
729 (elmo-field-body "from")
731 (setq subject (elmo-mime-string (or (elmo-field-body "subject")
733 (setq date (or (elmo-field-body "date") time))
734 (setq to (mapconcat 'identity (elmo-multiple-field-body "to") ","))
735 (setq cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
737 (if (setq size (elmo-field-body "content-length"))
738 (setq size (string-to-int size))
739 (setq size 0)));; No mean...
741 (if (setq field-body (elmo-field-body (car extras)))
742 (setq extra (cons (cons (downcase (car extras))
744 (setq extras (cdr extras)))
745 (cons message-id (vector number references
746 from subject date to cc
750 (defun elmo-msgdb-overview-sort-by-date (overview)
756 (timezone-make-date-sortable
757 (elmo-msgdb-overview-entity-get-date x))
758 (timezone-make-date-sortable
759 (elmo-msgdb-overview-entity-get-date y)))
762 (defun elmo-msgdb-sort-by-date (msgdb)
763 (message "Sorting...")
764 (let ((overview (elmo-msgdb-get-overview msgdb)))
765 (setq overview (elmo-msgdb-overview-sort-by-date overview))
766 (message "Sorting...done")
767 (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb))))
769 (defun elmo-msgdb-clear-overview-hashtb (entity hashtb)
772 elmo-use-overview-hashtb
774 (and (setq number (elmo-msgdb-overview-entity-get-number entity))
775 (elmo-clear-hash-val (format "#%d" number) hashtb))
776 (and (car entity) ;; message-id
777 (elmo-clear-hash-val (car entity) hashtb)))))
779 (defun elmo-msgdb-make-overview-hashtb (overview &optional hashtb)
780 (if elmo-use-overview-hashtb
781 (let ((hashtb (or hashtb ;; append
782 (elmo-make-hash (length overview)))))
786 (elmo-set-hash-val (caar overview) (car overview) hashtb))
789 (format "#%d" (elmo-msgdb-overview-entity-get-number (car overview)))
790 (car overview) hashtb)
791 (setq overview (cdr overview)))
795 (defsubst elmo-msgdb-append (msgdb msgdb-append &optional set-hash)
797 (nconc (car msgdb) (car msgdb-append))
798 (nconc (cadr msgdb) (cadr msgdb-append))
799 (nconc (caddr msgdb) (caddr msgdb-append))
800 (nconc (cadddr msgdb) (cadddr msgdb-append))
802 (elmo-msgdb-make-overview-hashtb (car msgdb-append) (nth 4 msgdb)))))
804 (defsubst elmo-msgdb-clear (&optional msgdb)
808 (setcar (cdr msgdb) nil)
809 (setcar (cddr msgdb) nil)
810 (setcar (cdddr msgdb) nil)
811 (setcar (nthcdr 4 msgdb) (elmo-msgdb-make-overview-hashtb nil)))
812 (list nil nil nil nil (elmo-msgdb-make-overview-hashtb nil))))
814 (defun elmo-msgdb-delete-path (folder &optional spec)
815 (let ((path (elmo-msgdb-expand-path (or spec folder))))
816 (if (file-directory-p path)
817 (elmo-delete-directory path t))))
819 (defun elmo-msgdb-rename-path (old-folder new-folder &optional old-spec new-spec)
820 (let* ((old (directory-file-name (elmo-msgdb-expand-path old-spec)))
821 (new (directory-file-name (elmo-msgdb-expand-path new-spec)))
822 (new-dir (directory-file-name (file-name-directory new))))
823 (if (not (file-directory-p old))
825 (if (file-exists-p new)
826 (error "Already exists directory: %s" new)
827 (if (not (file-exists-p new-dir))
828 (elmo-make-directory new-dir))
829 (rename-file old new)))))
831 (defun elmo-generic-folder-diff (spec folder &optional number-list)
832 (let ((cached-in-db-max (elmo-folder-get-info-max folder))
833 (in-folder (elmo-call-func folder "max-of-folder"))
837 (if (or number-list (not cached-in-db-max))
838 (let ((number-list (or number-list
840 (elmo-msgdb-number-load
841 (elmo-msgdb-expand-path folder))))))
843 (setq in-db (sort number-list '<))
844 (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db)
846 (if (not number-list)
847 (elmo-folder-set-info-hashtb folder in-db-max nil)))
848 (setq in-db-max cached-in-db-max))
849 (setq unsync (if (and in-db
851 (- (car in-folder) in-db-max)
855 (if (null (car in-folder))
857 (setq messages (cdr in-folder))
858 (if (and unsync messages (> unsync messages))
859 (setq unsync messages))
860 (cons (or unsync 0) (or messages 0))))
862 (defun elmo-generic-list-folder-unread (spec number-alist mark-alist
866 (function (lambda (x)
867 (if (member (cadr (assq (car x) mark-alist)) unread-marks)
871 (defsubst elmo-folder-get-info (folder &optional hashtb)
872 (elmo-get-hash-val folder
873 (or hashtb elmo-folder-info-hashtb)))
875 (defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread)
876 (let ((info (elmo-folder-get-info folder)))
878 (or new (setq new (nth 0 info)))
879 (or unread (setq unread (nth 1 info)))
880 (or numbers (setq numbers (nth 2 info)))
881 (or max (setq max (nth 3 info))))
882 (elmo-set-hash-val folder
883 (list new unread numbers max)
884 elmo-folder-info-hashtb)))
886 (defun elmo-folder-set-info-max-by-numdb (folder msgdb-number)
887 (let ((num-db (sort (mapcar 'car msgdb-number) '<)))
888 (elmo-folder-set-info-hashtb
890 (or (nth (max 0 (1- (length num-db))) num-db) 0)
891 nil ;;(length num-db)
894 (defun elmo-folder-get-info-max (folder)
895 "Get folder info from cache."
896 (nth 3 (elmo-folder-get-info folder)))
898 (defun elmo-folder-get-info-length (folder)
899 (nth 2 (elmo-folder-get-info folder)))
901 (defun elmo-folder-get-info-unread (folder)
902 (nth 1 (elmo-folder-get-info folder)))
904 (defun elmo-folder-info-make-hashtb (info-alist hashtb)
905 (let* ((hashtb (or hashtb
906 (elmo-make-hash (length info-alist)))))
909 (let ((info (cadr x)))
910 (and (intern-soft (car x) hashtb)
911 (elmo-set-hash-val (car x)
912 (list (nth 2 info) ;; new
913 (nth 3 info) ;; unread
914 (nth 1 info) ;; length
918 (setq elmo-folder-info-hashtb hashtb)))
921 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
923 ;;; elmo-msgdb.el ends here