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.
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
40 ;; cache backend by Kenichi OKADA <okada@opaopa.org>
43 (luna-define-class elmo-cache-folder (elmo-map-folder) (dir-name directory))
44 (luna-define-internal-accessors 'elmo-cache-folder))
46 (luna-define-method elmo-folder-initialize ((folder elmo-cache-folder)
48 (when (string-match "\\([^/]*\\)/?\\(.*\\)$" name)
49 (elmo-cache-folder-set-dir-name-internal
51 (elmo-match-string 2 name))
52 (elmo-cache-folder-set-directory-internal
54 (expand-file-name (elmo-match-string 2 name)
55 (expand-file-name elmo-cache-dirname elmo-msgdb-dir)))
58 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-cache-folder))
59 (expand-file-name (elmo-cache-folder-dir-name-internal folder)
60 (expand-file-name "internal/cache"
63 (luna-define-method elmo-map-folder-list-message-locations
64 ((folder elmo-cache-folder))
65 (elmo-cache-folder-list-message-locations folder))
67 (defun elmo-cache-folder-list-message-locations (folder)
68 (mapcar 'file-name-nondirectory
71 (directory-files (elmo-cache-folder-directory-internal folder)
72 t "^[^@]+@[^@]+$" t))))
74 (luna-define-method elmo-folder-list-subfolders ((folder elmo-cache-folder)
77 (lambda (f) (if (file-directory-p f)
78 (concat (elmo-folder-prefix-internal folder)
80 (file-name-nondirectory f))))
81 (directory-files (elmo-cache-folder-directory-internal folder)
84 (luna-define-method elmo-folder-message-file-p ((folder elmo-cache-folder))
87 (luna-define-method elmo-message-file-name ((folder elmo-cache-folder)
90 (elmo-map-message-location folder number)
91 (elmo-cache-folder-directory-internal folder)))
93 (luna-define-method elmo-folder-msgdb-create ((folder elmo-cache-folder)
95 already-mark seen-mark
99 (len (length numbers))
100 overview number-alist mark-alist entity message-id
102 (message "Creating msgdb...")
105 (elmo-msgdb-create-overview-entity-from-file
106 (car numbers) (elmo-message-file-name folder (car numbers))))
109 (setq num (elmo-msgdb-overview-entity-get-number entity))
111 (elmo-msgdb-append-element
113 (setq message-id (elmo-msgdb-overview-entity-get-id entity))
115 (elmo-msgdb-number-add number-alist
118 (if (setq mark (or (elmo-msgdb-global-mark-get message-id)
119 (if (member message-id seen-list) nil new-mark)))
121 (elmo-msgdb-mark-append
124 (when (> len elmo-display-progress-threshold)
126 (elmo-display-progress
127 'elmo-cache-folder-msgdb-create "Creating msgdb..."
129 (setq numbers (cdr numbers)))
130 (message "Creating msgdb...done")
131 (list overview number-alist mark-alist)))
133 (luna-define-method elmo-folder-append-buffer ((folder elmo-cache-folder)
136 ;; dir-name is changed according to msgid.
137 (unless (elmo-cache-folder-dir-name-internal folder)
138 (let* ((file (elmo-file-cache-get-path (std11-field-body "message-id")))
139 (dir (directory-file-name (file-name-directory file))))
140 (unless (file-exists-p dir)
141 (elmo-make-directory dir))
142 (when (file-writable-p file)
143 (write-region-as-binary
144 (point-min) (point-max) file nil 'no-msg))))
147 (luna-define-method elmo-map-folder-delete-messages ((folder elmo-cache-folder)
149 (dolist (location locations)
150 (elmo-file-cache-delete
151 (expand-file-name location
152 (elmo-cache-folder-directory-internal folder)))))
154 (luna-define-method elmo-message-fetch-with-cache-process
155 ((folder elmo-cache-folder) number strategy &optional section unseen)
156 ;; disbable cache process
157 (elmo-message-fetch-internal folder number strategy section unseen))
159 (luna-define-method elmo-map-message-fetch ((folder elmo-cache-folder)
161 &optional section unseen)
162 (let ((file (expand-file-name
164 (elmo-cache-folder-directory-internal folder))))
165 (when (file-exists-p file)
166 (insert-file-contents-as-binary file))))
168 (luna-define-method elmo-folder-creatable-p ((folder elmo-cache-folder))
171 (luna-define-method elmo-folder-writable-p ((folder elmo-cache-folder))
174 (luna-define-method elmo-folder-exists-p ((folder elmo-cache-folder))
177 (luna-define-method elmo-folder-search ((folder elmo-cache-folder)
178 condition &optional from-msgs)
179 (let* ((msgs (or from-msgs (elmo-folder-list-messages folder)))
187 (if (and (setq file (elmo-message-file-name folder (car msgs)))
189 (elmo-file-field-condition-match file
193 (setq matched (nconc matched (list (car msgs)))))
194 (elmo-display-progress
195 'elmo-internal-folder-search "Searching..."
196 (/ (* (setq i (1+ i)) 100) num))
197 (setq msgs (cdr msgs)))
200 (luna-define-method elmo-message-file-p ((folder elmo-cache-folder) number)
203 ;;; To override elmo-map-folder methods.
204 (luna-define-method elmo-folder-list-unreads-internal
205 ((folder elmo-cache-folder) unread-marks &optional mark-alist)
208 (luna-define-method elmo-folder-unmark-important ((folder elmo-cache-folder)
212 (luna-define-method elmo-folder-mark-as-important ((folder elmo-cache-folder)
216 (luna-define-method elmo-folder-unmark-read ((folder elmo-cache-folder)
220 (luna-define-method elmo-folder-mark-as-read ((folder elmo-cache-folder)
225 (product-provide (provide 'elmo-cache) (require 'elmo-version))
227 ;;; elmo-cache.el ends here