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 flag number)
117 ;; dir-name is changed according to msgid.
118 (unless (elmo-cache-folder-dir-name-internal folder)
119 (let* ((file (elmo-file-cache-get-path (std11-field-body "message-id")))
120 (dir (directory-file-name (file-name-directory file))))
121 (unless (file-exists-p dir)
122 (elmo-make-directory dir))
123 (when (file-writable-p file)
124 (write-region-as-binary
125 (point-min) (point-max) file nil 'no-msg))))
128 (luna-define-method elmo-map-folder-delete-messages ((folder elmo-cache-folder)
130 (dolist (location locations)
131 (elmo-file-cache-delete
132 (expand-file-name location
133 (elmo-cache-folder-directory-internal folder)))))
135 (luna-define-method elmo-message-fetch-with-cache-process
136 ((folder elmo-cache-folder) number strategy &optional section unseen)
137 ;; disbable cache process
138 (elmo-message-fetch-internal folder number strategy section unseen))
140 (luna-define-method elmo-map-message-fetch ((folder elmo-cache-folder)
142 &optional section unseen)
143 (let ((file (expand-file-name
145 (elmo-cache-folder-directory-internal folder))))
146 (when (file-exists-p file)
147 (insert-file-contents-as-binary file))))
149 (luna-define-method elmo-folder-writable-p ((folder elmo-cache-folder))
152 (luna-define-method elmo-folder-exists-p ((folder elmo-cache-folder))
155 (luna-define-method elmo-message-file-p ((folder elmo-cache-folder) number)
159 (product-provide (provide 'elmo-cache) (require 'elmo-version))
161 ;;; elmo-cache.el ends here