New feature: toggle visibility of mime buttons.
[more-wl.git] / elmo / elmo-cache.el
blob37f506cda8af1a231f106915af9dd72b7e2bab66
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)
15 ;; any later version.
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.
28 ;;; Commentary:
31 ;;; Code:
33 (require 'elmo-vars)
34 (require 'elmo-util)
35 (require 'elmo)
36 (require 'elmo-map)
38 (eval-and-compile
39 (luna-define-class elmo-cache-folder (elmo-map-folder elmo-file-tag)
40 (dir-name directory))
41 (luna-define-internal-accessors 'elmo-cache-folder))
43 (luna-define-method elmo-folder-initialize ((folder elmo-cache-folder)
44 name)
45 (when (string-match "\\([^/]*\\)/?\\(.*\\)$" name)
46 (elmo-cache-folder-set-dir-name-internal
47 folder
48 (elmo-match-string 2 name))
49 (elmo-cache-folder-set-directory-internal
50 folder
51 (expand-file-name (elmo-match-string 2 name)
52 elmo-cache-directory))
53 folder))
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
66 (elmo-delete-if
67 'file-directory-p
68 (directory-files (elmo-cache-folder-directory-internal folder)
69 t "^[^@]+@[^@]+$" t))))
71 (luna-define-method elmo-folder-list-subfolders ((folder elmo-cache-folder)
72 &optional one-level)
73 (delq nil (mapcar
74 (lambda (f) (if (file-directory-p f)
75 (concat (elmo-folder-prefix-internal folder)
76 "cache/"
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)
85 number)
86 (expand-file-name
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)
91 numbers flag-table)
92 (let ((new-msgdb (elmo-make-msgdb))
93 entity message-id flags)
94 (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
95 "Creating msgdb"
96 (dolist (number numbers)
97 (setq entity
98 (elmo-msgdb-create-message-entity-from-file
99 (elmo-msgdb-message-entity-handler new-msgdb)
100 number
101 (elmo-message-file-name folder number)))
102 (when entity
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 number message-id)
106 (elmo-msgdb-append-entity new-msgdb entity flags))
107 (elmo-progress-notify 'elmo-folder-msgdb-create)))
108 new-msgdb))
110 (luna-define-method elmo-folder-append-buffer ((folder elmo-cache-folder)
111 &optional flags number)
112 ;; dir-name is changed according to msgid.
113 (unless (elmo-cache-folder-dir-name-internal folder)
114 (let ((msgid (std11-field-body "message-id"))
115 file dir)
116 (when msgid
117 (setq file (elmo-file-cache-get-path msgid))
118 (setq dir (directory-file-name (file-name-directory file)))
119 (unless (file-exists-p dir)
120 (elmo-make-directory dir))
121 (when (and (file-writable-p file)
122 (not (file-exists-p file)))
123 (write-region-as-binary
124 (point-min) (point-max) file nil 'no-msg)
125 (elmo-folder-preserve-flags folder msgid flags)
126 t)))))
128 (luna-define-method elmo-map-folder-delete-messages ((folder elmo-cache-folder)
129 locations)
130 (dolist (location locations)
131 (elmo-file-cache-delete
132 (expand-file-name location
133 (elmo-cache-folder-directory-internal folder))))
136 (luna-define-method elmo-message-fetch
137 ((folder elmo-cache-folder) number strategy &optional unseen section)
138 ;; disable cache process
139 (erase-buffer)
140 (when (elmo-message-fetch-internal folder number strategy section unseen)
141 (when (and (not unseen)
142 (elmo-message-flagged-p folder number 'unread))
143 (elmo-message-unset-flag folder number 'unread))
146 (luna-define-method elmo-map-message-fetch ((folder elmo-cache-folder)
147 location strategy
148 &optional section unseen)
149 (let ((file (expand-file-name
150 location
151 (elmo-cache-folder-directory-internal folder))))
152 (when (file-exists-p file)
153 (insert-file-contents-as-binary file))))
155 (luna-define-method elmo-folder-writable-p ((folder elmo-cache-folder))
158 (luna-define-method elmo-folder-exists-p ((folder elmo-cache-folder))
161 (luna-define-method elmo-message-file-p ((folder elmo-cache-folder) number)
164 (require 'product)
165 (product-provide (provide 'elmo-cache) (require 'elmo-version))
167 ;;; elmo-cache.el ends here