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) (dir-name directory))
40 (luna-define-internal-accessors 'elmo-cache-folder))
42 (luna-define-method elmo-folder-initialize ((folder elmo-cache-folder)
44 (when (string-match "\\([^/]*\\)/?\\(.*\\)$" name)
45 (elmo-cache-folder-set-dir-name-internal
47 (elmo-match-string 2 name))
48 (elmo-cache-folder-set-directory-internal
50 (expand-file-name (elmo-match-string 2 name)
51 elmo-cache-directory))
54 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-cache-folder))
55 (expand-file-name (elmo-cache-folder-dir-name-internal folder)
56 (expand-file-name "internal/cache"
57 elmo-msgdb-directory)))
59 (luna-define-method elmo-map-folder-list-message-locations
60 ((folder elmo-cache-folder))
61 (elmo-cache-folder-list-message-locations folder))
63 (defun elmo-cache-folder-list-message-locations (folder)
64 (mapcar 'file-name-nondirectory
67 (directory-files (elmo-cache-folder-directory-internal folder)
68 t "^[^@]+@[^@]+$" t))))
70 (luna-define-method elmo-folder-list-subfolders ((folder elmo-cache-folder)
73 (lambda (f) (if (file-directory-p f)
74 (concat (elmo-folder-prefix-internal folder)
76 (file-name-nondirectory f))))
77 (directory-files (elmo-cache-folder-directory-internal folder)
78 t "^[01][0-9A-F]$"))))
80 (luna-define-method elmo-folder-message-file-p ((folder elmo-cache-folder))
83 (luna-define-method elmo-message-file-name ((folder elmo-cache-folder)
86 (elmo-map-message-location folder number)
87 (elmo-cache-folder-directory-internal folder)))
89 (luna-define-method elmo-folder-msgdb-create ((folder elmo-cache-folder)
92 (len (length numbers))
93 (new-msgdb (elmo-make-msgdb))
94 entity message-id flags)
95 (message "Creating msgdb...")
98 (elmo-msgdb-create-message-entity-from-file
99 (elmo-msgdb-message-entity-handler new-msgdb)
100 (car numbers) (elmo-message-file-name folder (car numbers))))
102 (setq message-id (elmo-message-entity-field entity 'message-id)
103 flags (elmo-flag-table-get flag-table message-id))
104 (elmo-global-flags-set flags folder (car numbers) message-id)
105 (elmo-msgdb-append-entity new-msgdb entity flags))
106 (when (> len elmo-display-progress-threshold)
108 (elmo-display-progress
109 'elmo-cache-folder-msgdb-create "Creating msgdb..."
111 (setq numbers (cdr numbers)))
112 (message "Creating msgdb...done")
115 (luna-define-method elmo-folder-append-buffer ((folder elmo-cache-folder)
116 &optional flags number)
117 ;; dir-name is changed according to msgid.
118 (unless (elmo-cache-folder-dir-name-internal folder)
119 (let ((msgid (std11-field-body "message-id"))
122 (setq file (elmo-file-cache-get-path msgid))
123 (setq dir (directory-file-name (file-name-directory file)))
124 (unless (file-exists-p dir)
125 (elmo-make-directory dir))
126 (when (and (file-writable-p file)
127 (not (file-exists-p file)))
128 (write-region-as-binary
129 (point-min) (point-max) file nil 'no-msg)
130 (elmo-folder-preserve-flags folder msgid flags)
133 (luna-define-method elmo-map-folder-delete-messages ((folder elmo-cache-folder)
135 (dolist (location locations)
136 (elmo-file-cache-delete
137 (expand-file-name location
138 (elmo-cache-folder-directory-internal folder))))
141 (luna-define-method elmo-message-fetch
142 ((folder elmo-cache-folder) number strategy &optional unseen section)
143 ;; disbable cache process
145 (when (elmo-message-fetch-internal folder number strategy section unseen)
146 (when (and (not unseen)
147 (elmo-message-flagged-p folder number 'unread))
148 (elmo-message-unset-flag folder number 'unread))
151 (luna-define-method elmo-map-message-fetch ((folder elmo-cache-folder)
153 &optional section unseen)
154 (let ((file (expand-file-name
156 (elmo-cache-folder-directory-internal folder))))
157 (when (file-exists-p file)
158 (insert-file-contents-as-binary file))))
160 (luna-define-method elmo-folder-writable-p ((folder elmo-cache-folder))
163 (luna-define-method elmo-folder-exists-p ((folder elmo-cache-folder))
166 (luna-define-method elmo-message-file-p ((folder elmo-cache-folder) number)
170 (product-provide (provide 'elmo-cache) (require 'elmo-version))
172 ;;; elmo-cache.el ends here