1 ;;; elmo-cache.el --- Cache modules for ELMO.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 2000 Kenichi OKADA <okada@opaopa.org>
6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
7 ;; Kenichi OKADA <okada@opaopa.org>
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.
39 (luna-define-class elmo-cache-folder (elmo-map-folder elmo-file-tag)
41 (luna-define-internal-accessors 'elmo-cache-folder))
43 (luna-define-method elmo-folder-initialize ((folder elmo-cache-folder)
45 (when (string-match "\\([^/]*\\)/?\\(.*\\)$" name)
46 (elmo-cache-folder-set-dir-name-internal
48 (elmo-match-string 2 name))
49 (elmo-cache-folder-set-directory-internal
51 (expand-file-name (elmo-match-string 2 name)
52 elmo-cache-directory))
55 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-cache-folder))
56 (expand-file-name (elmo-cache-folder-dir-name-internal folder)
57 (expand-file-name "internal/cache"
58 elmo-msgdb-directory)))
60 (luna-define-method elmo-map-folder-list-message-locations
61 ((folder elmo-cache-folder))
62 (elmo-cache-folder-list-message-locations folder))
64 (defun elmo-cache-folder-list-message-locations (folder)
65 (mapcar 'file-name-nondirectory
68 (directory-files (elmo-cache-folder-directory-internal folder)
69 t "^[^@]+@[^@]+$" t))))
71 (luna-define-method elmo-folder-list-subfolders ((folder elmo-cache-folder)
74 (lambda (f) (if (file-directory-p f)
75 (concat (elmo-folder-prefix-internal folder)
77 (file-name-nondirectory f))))
78 (directory-files (elmo-cache-folder-directory-internal folder)
79 t "^[01][0-9A-F]$"))))
81 (luna-define-method elmo-folder-message-file-p ((folder elmo-cache-folder))
84 (luna-define-method elmo-message-file-name ((folder elmo-cache-folder)
87 (elmo-map-message-location folder number)
88 (elmo-cache-folder-directory-internal folder)))
90 (luna-define-method elmo-folder-msgdb-create ((folder elmo-cache-folder)
93 (len (length numbers))
94 (new-msgdb (elmo-make-msgdb))
95 entity message-id flags)
96 (message "Creating msgdb...")
99 (elmo-msgdb-create-message-entity-from-file
100 (elmo-msgdb-message-entity-handler new-msgdb)
101 (car numbers) (elmo-message-file-name folder (car numbers))))
103 (setq message-id (elmo-message-entity-field entity 'message-id)
104 flags (elmo-flag-table-get flag-table message-id))
105 (elmo-global-flags-set flags folder (car numbers) message-id)
106 (elmo-msgdb-append-entity new-msgdb entity flags))
107 (when (> len elmo-display-progress-threshold)
109 (elmo-display-progress
110 'elmo-cache-folder-msgdb-create "Creating msgdb..."
112 (setq numbers (cdr numbers)))
113 (message "Creating msgdb...done")
116 (luna-define-method elmo-folder-append-buffer ((folder elmo-cache-folder)
117 &optional flags number)
118 ;; dir-name is changed according to msgid.
119 (unless (elmo-cache-folder-dir-name-internal folder)
120 (let ((msgid (std11-field-body "message-id"))
123 (setq file (elmo-file-cache-get-path msgid))
124 (setq dir (directory-file-name (file-name-directory file)))
125 (unless (file-exists-p dir)
126 (elmo-make-directory dir))
127 (when (and (file-writable-p file)
128 (not (file-exists-p file)))
129 (write-region-as-binary
130 (point-min) (point-max) file nil 'no-msg)
131 (elmo-folder-preserve-flags folder msgid flags)
134 (luna-define-method elmo-map-folder-delete-messages ((folder elmo-cache-folder)
136 (dolist (location locations)
137 (elmo-file-cache-delete
138 (expand-file-name location
139 (elmo-cache-folder-directory-internal folder))))
142 (luna-define-method elmo-message-fetch
143 ((folder elmo-cache-folder) number strategy &optional unseen section)
144 ;; disable cache process
146 (when (elmo-message-fetch-internal folder number strategy section unseen)
147 (when (and (not unseen)
148 (elmo-message-flagged-p folder number 'unread))
149 (elmo-message-unset-flag folder number 'unread))
152 (luna-define-method elmo-map-message-fetch ((folder elmo-cache-folder)
154 &optional section unseen)
155 (let ((file (expand-file-name
157 (elmo-cache-folder-directory-internal folder))))
158 (when (file-exists-p file)
159 (insert-file-contents-as-binary file))))
161 (luna-define-method elmo-folder-writable-p ((folder elmo-cache-folder))
164 (luna-define-method elmo-folder-exists-p ((folder elmo-cache-folder))
167 (luna-define-method elmo-message-file-p ((folder elmo-cache-folder) number)
171 (product-provide (provide 'elmo-cache) (require 'elmo-version))
173 ;;; elmo-cache.el ends here