1 ;;; elmo-msgdb.el -- Message Database for Elmo.
3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
32 (eval-when-compile (require 'cl))
39 (defun elmo-msgdb-expand-path (folder &optional spec)
40 (convert-standard-filename
41 (let* ((spec (or spec (elmo-folder-get-spec folder)))
46 (setq fld (elmo-imap4-spec-mailbox spec))
47 (if (string= "inbox" (downcase fld))
49 (if (eq (string-to-char fld) ?/)
50 (setq fld (substring fld 1 (length fld))))
53 (expand-file-name (or (elmo-imap4-spec-username spec) "nobody")
55 (elmo-imap4-spec-hostname spec)
62 (elmo-nntp-spec-group spec)
63 (expand-file-name (or (elmo-nntp-spec-hostname spec) "nowhere")
64 (expand-file-name "nntp"
67 (expand-file-name (elmo-safe-filename (nth 1 spec))
68 (expand-file-name "maildir"
71 (expand-file-name (elmo-safe-filename (nth 1 spec))
72 (expand-file-name "folder"
75 (setq fld (concat "*" (mapconcat 'identity (cdr spec) ",")))
76 (expand-file-name (elmo-safe-filename fld)
77 (expand-file-name "multi"
81 (elmo-safe-filename folder)
82 (expand-file-name "filter"
88 (elmo-replace-in-string
89 (elmo-replace-in-string
90 (elmo-replace-in-string
96 (expand-file-name (concat (symbol-name type) "/"
97 (symbol-name (nth 2 spec)))
101 (elmo-safe-filename (elmo-pop3-spec-username spec))
102 (expand-file-name (elmo-pop3-spec-hostname spec)
106 ((eq type 'localnews)
108 (elmo-replace-in-string (nth 1 spec) "/" ".")
109 (expand-file-name "localnews"
112 (expand-file-name (elmo-safe-filename (concat (symbol-name (nth 1 spec))
114 (expand-file-name "internal"
117 (expand-file-name (elmo-safe-filename (nth 1 spec))
118 (expand-file-name "internal/cache"
120 (t ; local dir or undefined type
122 (setq fld (nth 1 spec))
123 (if (file-name-absolute-p fld)
124 (setq fld (elmo-safe-filename fld)))
125 (expand-file-name fld
126 (expand-file-name (symbol-name type)
127 elmo-msgdb-dir)))))))
129 (defsubst elmo-msgdb-append-element (list element)
131 ;(append list (list element))
132 (nconc list (list element))
136 (defsubst elmo-msgdb-get-overview (msgdb)
138 (defsubst elmo-msgdb-get-number-alist (msgdb)
140 (defsubst elmo-msgdb-get-mark-alist (msgdb)
142 (defsubst elmo-msgdb-get-location (msgdb)
144 (defsubst elmo-msgdb-get-overviewht (msgdb)
148 ;; number <-> Message-ID handling
150 (defsubst elmo-msgdb-number-add (alist number id)
151 (let ((ret-val alist))
153 (elmo-msgdb-append-element ret-val (cons number id)))
157 ;; parsistent mark handling
160 (defvar elmo-msgdb-global-mark-alist nil)
162 (defun elmo-msgdb-global-mark-delete (msgid)
163 (let* ((path (expand-file-name
164 elmo-msgdb-global-mark-filename
166 (malist (or elmo-msgdb-global-mark-alist
167 (setq elmo-msgdb-global-mark-alist
168 (elmo-object-load path))))
170 (when (setq match (assoc msgid malist))
171 (setq elmo-msgdb-global-mark-alist
172 (delete match elmo-msgdb-global-mark-alist))
173 (elmo-object-save path elmo-msgdb-global-mark-alist))))
175 (defun elmo-msgdb-global-mark-set (msgid mark)
176 (let* ((path (expand-file-name
177 elmo-msgdb-global-mark-filename
179 (malist (or elmo-msgdb-global-mark-alist
180 (setq elmo-msgdb-global-mark-alist
181 (elmo-object-load path))))
183 (if (setq match (assoc msgid malist))
185 (setq elmo-msgdb-global-mark-alist
186 (nconc elmo-msgdb-global-mark-alist
187 (list (cons msgid mark)))))
188 (elmo-object-save path elmo-msgdb-global-mark-alist)))
190 (defun elmo-msgdb-global-mark-get (msgid)
191 (cdr (assoc msgid (or elmo-msgdb-global-mark-alist
192 (setq elmo-msgdb-global-mark-alist
195 elmo-msgdb-global-mark-filename
196 elmo-msgdb-dir)))))))
199 ;; number <-> location handling
201 (defsubst elmo-msgdb-location-load (dir)
204 elmo-msgdb-location-filename
207 (defsubst elmo-msgdb-location-add (alist number location)
208 (let ((ret-val alist))
210 (elmo-msgdb-append-element ret-val (cons number location)))
213 (defsubst elmo-msgdb-location-save (dir alist)
216 elmo-msgdb-location-filename
219 (defun elmo-list-folder-by-location (spec locations &optional msgdb)
220 (let* ((path (elmo-msgdb-expand-path nil spec))
221 (location-alist (if msgdb
222 (elmo-msgdb-get-location msgdb)
223 (elmo-msgdb-location-load path)))
224 (locations-in-db (mapcar 'cdr location-alist))
225 result new-locs new-alist deleted-locs i
228 (elmo-delete-if (function
229 (lambda (x) (member x locations-in-db)))
232 (elmo-delete-if (function
233 (lambda (x) (member x locations)))
235 (setq modified new-locs)
236 (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
241 (delq (rassoc x location-alist) location-alist))))
245 (setq new-alist (cons (cons i (car new-locs)) new-alist))
246 (setq new-locs (cdr new-locs)))
247 (setq result (nconc location-alist new-alist))
248 (setq result (sort result (lambda (x y) (< (car x)(car y)))))
249 (if modified (elmo-msgdb-location-save path result))
250 (mapcar 'car result)))
253 ;; persistent mark handling
255 (defun elmo-msgdb-mark-set (alist id mark)
256 (let ((ret-val alist)
258 (setq entity (assq id alist))
261 ;; delete this entity
262 (setq ret-val (delq entity alist))
264 (setcar (cdr entity) mark))
266 (setq ret-val (elmo-msgdb-append-element ret-val
270 (defun elmo-msgdb-mark-append (alist id mark)
272 (setq alist (elmo-msgdb-append-element alist
275 (defun elmo-msgdb-mark-alist-to-seen-list (number-alist mark-alist seen-marks)
276 "Make seen-list from mark-alist"
277 (let ((seen-mark-list (string-to-char-list seen-marks))
280 (if (setq ent (assq (car (car number-alist)) mark-alist))
282 (memq (string-to-char (cadr ent)) seen-mark-list))
283 (setq ret-val (cons (cdr (car number-alist)) ret-val)))
284 (setq ret-val (cons (cdr (car number-alist)) ret-val)))
285 (setq number-alist (cdr number-alist)))
291 (defvar elmo-msgdb-decoded-cache-hashtb nil)
292 (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
294 (defsubst elmo-msgdb-get-decoded-cache (string)
295 (if elmo-use-decoded-cache
296 (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
297 (setq elmo-msgdb-decoded-cache-hashtb
298 (elmo-make-hash 2048))))
300 (or (elmo-get-hash-val string hashtb)
305 (decode-mime-charset-string string elmo-mime-charset))
308 (decode-mime-charset-string string elmo-mime-charset)))
314 (defsubst elmo-msgdb-get-field-value (field-name beg end buffer)
318 (narrow-to-region beg end)
319 (elmo-field-body field-name))))
321 (defun elmo-multiple-field-body (name &optional boundary)
324 (std11-narrow-to-header boundary)
325 (goto-char (point-min))
326 (let ((case-fold-search t)
328 (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
331 (list (buffer-substring-no-properties
332 (match-end 0) (std11-field-end))))))
335 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
336 "Return list of each field-bodies of FIELD-NAMES of the message header
337 in current buffer. If BOUNDARY is not nil, it is used as message
341 (std11-narrow-to-header boundary)
342 (let* ((case-fold-search t)
344 field-name field-body)
345 (while (setq field-name (car s-rest))
346 (goto-char (point-min))
347 (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
350 (list (buffer-substring-no-properties
351 (match-end 0) (std11-field-end))))))
352 (setq s-rest (cdr s-rest)))
355 (defsubst elmo-msgdb-remove-field-string (string)
356 (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
357 (substring string (match-end 0))
360 (defsubst elmo-msgdb-get-last-message-id (string)
366 (goto-char (point-max))
367 (when (search-backward "<" nil t)
369 (if (search-forward ">" nil t)
370 (elmo-replace-in-string
371 (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
373 (defun elmo-msgdb-number-load (dir)
375 (expand-file-name elmo-msgdb-number-filename dir)))
377 (defun elmo-msgdb-overview-load (dir)
379 (expand-file-name elmo-msgdb-overview-filename dir)))
381 (defun elmo-msgdb-mark-load (dir)
383 (expand-file-name elmo-msgdb-mark-filename dir)))
385 (defsubst elmo-msgdb-seen-load (dir)
386 (elmo-object-load (expand-file-name
387 elmo-msgdb-seen-filename
390 (defun elmo-msgdb-number-save (dir obj)
392 (expand-file-name elmo-msgdb-number-filename dir)
395 (defun elmo-msgdb-mark-save (dir obj)
397 (expand-file-name elmo-msgdb-mark-filename dir)
400 (defsubst elmo-msgdb-seen-save (dir obj)
402 (expand-file-name elmo-msgdb-seen-filename dir)
405 (defsubst elmo-msgdb-overview-save (dir overview)
407 (expand-file-name elmo-msgdb-overview-filename dir)
410 (defun elmo-msgdb-delete-msgs (folder msgs msgdb &optional reserve-cache)
411 "Delete MSGS from FOLDER in MSGDB.
412 content of MSGDB is changed."
414 (let* ((msg-list msgs)
415 (dir (elmo-msgdb-expand-path folder))
416 (overview (or (car msgdb)
417 (elmo-msgdb-overview-load dir)))
418 (number-alist (or (cadr msgdb)
419 (elmo-msgdb-number-load dir)))
420 (mark-alist (or (caddr msgdb)
421 (elmo-msgdb-mark-load dir)))
422 (loc-alist (or (elmo-msgdb-get-location msgdb)
423 (elmo-msgdb-location-load dir)))
424 (hashtb (or (elmo-msgdb-get-overviewht msgdb)
425 (elmo-msgdb-make-overview-hashtb overview)))
426 (newmsgdb (list overview number-alist mark-alist (nth 3 msgdb) hashtb))
427 ov-entity message-id)
428 ;; remove from current database.
430 (setq message-id (cdr (assq (car msg-list) number-alist)))
431 (if (and (not reserve-cache) message-id)
432 (elmo-cache-delete message-id
433 folder (car msg-list)))
434 ;; This is no good!!!!
435 ;(setq overview (delete (assoc message-id overview) overview))
439 (elmo-msgdb-overview-get-entity (car msg-list) newmsgdb))
441 (when (and elmo-use-overview-hashtb hashtb)
442 (elmo-msgdb-clear-overview-hashtb ov-entity hashtb))
444 (delq (assq (car msg-list) number-alist) number-alist))
445 (setq mark-alist (delq (assq (car msg-list) mark-alist) mark-alist))
446 (setq loc-alist (delq (assq (car msg-list) loc-alist) loc-alist))
447 (setq msg-list (cdr msg-list)))
448 (setcar msgdb overview)
449 (setcar (cdr msgdb) number-alist)
450 (setcar (cddr msgdb) mark-alist)
451 (setcar (nthcdr 4 msgdb) hashtb))
454 (defsubst elmo-msgdb-set-overview (msgdb overview)
455 (setcar msgdb overview))
457 (defsubst elmo-msgdb-set-number-alist (msgdb number-alist)
458 (setcar (cdr msgdb) number-alist))
460 (defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
461 (setcar (cddr msgdb) mark-alist))
463 (defsubst elmo-msgdb-overview-entity-get-references (entity)
464 (and entity (aref (cdr entity) 1)))
466 ;; entity -> parent-entity
467 (defsubst elmo-msgdb-overview-get-parent-entity (entity database)
468 (setq entity (elmo-msgdb-overview-entity-get-references entity))
469 ;; entity is parent-id.
470 (and entity (assoc entity database)))
472 (defsubst elmo-msgdb-overview-entity-get-number (entity)
473 (and entity (aref (cdr entity) 0)))
475 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
476 (and entity (aref (cdr entity) 2)))
478 (defsubst elmo-msgdb-overview-entity-get-from (entity)
480 (aref (cdr entity) 2)
481 (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
483 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
484 (and entity (aset (cdr entity) 0 number))
486 ;(setcar (cadr entity) number) entity)
488 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
489 (and entity (aset (cdr entity) 2 from))
492 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
494 (aref (cdr entity) 3)
495 (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
497 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
498 (and entity (aref (cdr entity) 3)))
500 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
501 (and entity (aset (cdr entity) 3 subject))
504 (defsubst elmo-msgdb-overview-entity-get-date (entity)
505 (and entity (aref (cdr entity) 4)))
507 (defsubst elmo-msgdb-overview-entity-get-to (entity)
508 (and entity (aref (cdr entity) 5)))
510 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
511 (and entity (aref (cdr entity) 6)))
513 (defsubst elmo-msgdb-overview-entity-get-size (entity)
514 (and entity (aref (cdr entity) 7)))
516 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
517 (and entity (aset (cdr entity) 7 size))
520 (defsubst elmo-msgdb-overview-entity-get-id (entity)
521 (and entity (car entity)))
523 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
524 (let ((extra (and entity (aref (cdr entity) 8))))
526 (cdr (assoc field-name extra)))))
528 (defun elmo-msgdb-overview-get-entity-by-number (database number)
533 (if (eq (elmo-msgdb-overview-entity-get-number (car db)) number)
534 (setq entity (car db)
539 (defun elmo-msgdb-overview-get-entity (id msgdb)
541 (let ((ovht (elmo-msgdb-get-overviewht msgdb)))
542 (if ovht ;; use overview hash
543 (if (stringp id) ;; ID is message-id
544 (elmo-get-hash-val id ovht)
545 (elmo-get-hash-val (format "#%d" id) ovht))
546 (let* ((overview (elmo-msgdb-get-overview msgdb))
547 (number-alist (elmo-msgdb-get-number-alist msgdb))
548 (message-id (if (stringp id)
549 id ;; ID is message-id
550 (cdr (assq id number-alist))))
553 (assoc message-id overview)
554 ;; ID is number. message-id is nil or no exists in number-alist.
555 (elmo-msgdb-overview-get-entity-by-number overview id)))))))
558 ;; deleted message handling
560 (defun elmo-msgdb-killed-list-load (dir)
562 (expand-file-name elmo-msgdb-killed-filename dir)
565 (defun elmo-msgdb-killed-list-save (dir killed-list)
567 (expand-file-name elmo-msgdb-killed-filename dir)
570 (defun elmo-msgdb-killed-message-p (killed-list msg)
571 (memq msg killed-list))
573 (defun elmo-msgdb-set-as-killed (killed-list msg)
574 (elmo-msgdb-append-element killed-list msg))
576 (defun elmo-msgdb-append-to-killed-list (folder msgs)
577 (let ((dir (elmo-msgdb-expand-path folder)))
578 (elmo-msgdb-killed-list-save
580 (nconc (elmo-msgdb-killed-list-load dir)
583 (defun elmo-msgdb-finfo-load ()
584 (elmo-object-load (expand-file-name
585 elmo-msgdb-finfo-filename
587 elmo-mime-charset t))
589 (defun elmo-msgdb-finfo-save (finfo)
590 (elmo-object-save (expand-file-name
591 elmo-msgdb-finfo-filename
593 finfo elmo-mime-charset))
595 (defun elmo-msgdb-flist-load (folder)
596 (let ((flist-file (expand-file-name
597 elmo-msgdb-flist-filename
598 (elmo-msgdb-expand-path folder (list 'folder folder)))))
599 (elmo-object-load flist-file nil t)))
601 (defun elmo-msgdb-flist-save (folder flist)
602 (let ((flist-file (expand-file-name
603 elmo-msgdb-flist-filename
604 (elmo-msgdb-expand-path folder (list 'folder folder)))))
605 (elmo-object-save flist-file flist)))
607 (defun elmo-crosspost-alist-load ()
608 (elmo-object-load (expand-file-name
609 elmo-crosspost-alist-filename
613 (defun elmo-crosspost-alist-save (alist)
614 (elmo-object-save (expand-file-name
615 elmo-crosspost-alist-filename
619 (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
620 "Create overview entity from current buffer.
621 Header region is supposed to be narrowed."
623 (let ((extras elmo-msgdb-extra-fields)
624 message-id references from subject to cc date
626 (elmo-set-buffer-multibyte default-enable-multibyte-characters)
627 (setq message-id (elmo-field-body "message-id"))
629 (or (elmo-msgdb-get-last-message-id
630 (elmo-field-body "in-reply-to"))
631 (elmo-msgdb-get-last-message-id
632 (elmo-field-body "references"))))
633 (setq from (elmo-mime-string (elmo-delete-char
636 (elmo-field-body "from")
638 (setq subject (elmo-mime-string (or (elmo-field-body "subject")
640 (setq date (or (elmo-field-body "date") time))
641 (setq to (mapconcat 'identity (elmo-multiple-field-body "to") ","))
642 (setq cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
644 (if (setq size (elmo-field-body "content-length"))
645 (setq size (string-to-int size))
646 (setq size 0)));; No mean...
648 (if (setq field-body (elmo-field-body (car extras)))
649 (setq extra (cons (cons (downcase (car extras))
651 (setq extras (cdr extras)))
652 (cons message-id (vector number references
653 from subject date to cc
657 (defun elmo-msgdb-overview-sort-by-date (overview)
663 (timezone-make-date-sortable
664 (elmo-msgdb-overview-entity-get-date x))
665 (timezone-make-date-sortable
666 (elmo-msgdb-overview-entity-get-date y)))
669 (defun elmo-msgdb-sort-by-date (msgdb)
670 (message "Sorting...")
671 (let ((overview (elmo-msgdb-get-overview msgdb)))
672 (setq overview (elmo-msgdb-overview-sort-by-date overview))
673 (message "Sorting...done.")
674 (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb))))
676 (defun elmo-msgdb-clear-overview-hashtb (entity hashtb)
679 elmo-use-overview-hashtb
681 (and (setq number (elmo-msgdb-overview-entity-get-number entity))
682 (elmo-clear-hash-val (format "#%d" number) hashtb))
683 (and (car entity) ;; message-id
684 (elmo-clear-hash-val (car entity) hashtb)))))
686 (defun elmo-msgdb-make-overview-hashtb (overview &optional hashtb)
687 (if elmo-use-overview-hashtb
688 (let ((hashtb (or hashtb ;; append
689 (elmo-make-hash (length overview)))))
693 (elmo-set-hash-val (caar overview) (car overview) hashtb))
696 (format "#%d" (elmo-msgdb-overview-entity-get-number (car overview)))
697 (car overview) hashtb)
698 (setq overview (cdr overview)))
702 (defsubst elmo-msgdb-append (msgdb msgdb-append &optional set-hash)
704 (nconc (car msgdb) (car msgdb-append))
705 (nconc (cadr msgdb) (cadr msgdb-append))
706 (nconc (caddr msgdb) (caddr msgdb-append))
707 (nconc (cadddr msgdb) (cadddr msgdb-append))
709 (elmo-msgdb-make-overview-hashtb (car msgdb-append) (nth 4 msgdb)))))
711 (defsubst elmo-msgdb-clear (&optional msgdb)
715 (setcar (cdr msgdb) nil)
716 (setcar (cddr msgdb) nil)
717 (setcar (cdddr msgdb) nil)
718 (setcar (nthcdr 4 msgdb) (elmo-msgdb-make-overview-hashtb nil)))
719 (list nil nil nil nil (elmo-msgdb-make-overview-hashtb nil))))
721 (defun elmo-msgdb-delete-path (folder &optional spec)
722 (let ((path (elmo-msgdb-expand-path folder spec)))
723 (if (file-directory-p path)
724 (elmo-delete-directory path t))))
726 (defun elmo-msgdb-rename-path (old-folder new-folder &optional old-spec new-spec)
727 (let* ((old (directory-file-name (elmo-msgdb-expand-path old-folder old-spec)))
728 (new (directory-file-name (elmo-msgdb-expand-path new-folder new-spec)))
729 (new-dir (directory-file-name (file-name-directory new))))
730 (if (not (file-directory-p old))
732 (if (file-exists-p new)
733 (error "already exists directory: %s" new)
734 (if (not (file-exists-p new-dir))
735 (elmo-make-directory new-dir))
736 (rename-file old new)))))
738 (provide 'elmo-msgdb)
740 ;;; elmo-msgdb.el ends here