1 ;;; elmo-localdir.el --- Localdir Interface for ELMO.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
5 ;; Copyright (C) 1999,2000 Kenichi OKADA <okada@opaopa.org>
7 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
8 ;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
9 ;; Kenichi OKADA <okada@opaopa.org>
10 ;; Keywords: mail, net news
12 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
14 ;; This program is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
35 (eval-when-compile (require 'cl))
40 (defcustom elmo-localdir-folder-path "~/Mail"
41 "*Local mail directory (MH format) path."
45 (defvar elmo-localdir-lockfile-list nil)
47 ;;; ELMO Local directory folder
49 (luna-define-class elmo-localdir-folder (elmo-folder)
51 (luna-define-internal-accessors 'elmo-localdir-folder))
53 ;;; elmo-localdir specific methods.
54 (luna-define-generic elmo-localdir-folder-path (folder)
55 "Return local directory path of the FOLDER.")
57 (luna-define-generic elmo-localdir-folder-name (folder name)
58 "Return directory NAME for FOLDER.")
60 (luna-define-method elmo-localdir-folder-path ((folder elmo-localdir-folder))
61 elmo-localdir-folder-path)
63 (luna-define-method elmo-localdir-folder-name ((folder elmo-localdir-folder)
67 (luna-define-method elmo-folder-initialize ((folder
70 (elmo-localdir-folder-set-dir-name-internal folder name)
71 (if (file-name-absolute-p name)
72 (elmo-localdir-folder-set-directory-internal
74 (expand-file-name name))
75 (elmo-localdir-folder-set-directory-internal
78 (elmo-localdir-folder-name folder name)
79 (elmo-localdir-folder-path folder))))
82 ;; open, check, commit, and close are generic.
84 (luna-define-method elmo-folder-exists-p ((folder elmo-localdir-folder))
85 (file-directory-p (elmo-localdir-folder-directory-internal folder)))
87 (luna-define-method elmo-folder-expand-msgdb-path ((folder
88 elmo-localdir-folder))
94 'elmo-replace-string-as-filename
96 (let ((dir-name (elmo-localdir-folder-dir-name-internal folder)))
97 (if (file-name-absolute-p dir-name)
98 (expand-file-name dir-name)
102 (expand-file-name ;;"localdir"
103 (symbol-name (elmo-folder-type-internal folder))
104 elmo-msgdb-directory)))
106 (luna-define-method elmo-message-file-name ((folder
107 elmo-localdir-folder)
109 (expand-file-name (int-to-string number)
110 (elmo-localdir-folder-directory-internal folder)))
112 (luna-define-method elmo-folder-message-file-number-p ((folder
113 elmo-localdir-folder))
116 (luna-define-method elmo-folder-message-file-directory ((folder
117 elmo-localdir-folder))
118 (elmo-localdir-folder-directory-internal folder))
120 (luna-define-method elmo-folder-message-make-temp-file-p
121 ((folder elmo-localdir-folder))
124 (luna-define-method elmo-folder-message-make-temp-files ((folder
125 elmo-localdir-folder)
129 (let ((temp-dir (elmo-folder-make-temporary-directory folder))
130 (cur-number (or start-number 0)))
131 (dolist (number numbers)
134 (int-to-string number)
135 (elmo-localdir-folder-directory-internal folder))
137 (int-to-string (if start-number cur-number number))
142 (defun elmo-localdir-msgdb-create-entity (msgdb dir number)
143 (elmo-msgdb-create-message-entity-from-file
144 (elmo-msgdb-message-entity-handler msgdb)
145 number (expand-file-name (int-to-string number) dir)))
147 (luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder)
151 (let ((dir (elmo-localdir-folder-directory-internal folder))
152 (new-msgdb (elmo-make-msgdb))
156 (len (length numbers)))
157 (message "Creating msgdb...")
160 (elmo-localdir-msgdb-create-entity
161 new-msgdb dir (car numbers)))
163 (setq message-id (elmo-message-entity-field entity 'message-id)
164 flags (elmo-flag-table-get flag-table message-id))
165 (elmo-global-flags-set flags folder (car numbers) message-id)
166 (elmo-msgdb-append-entity new-msgdb entity flags))
167 (when (> len elmo-display-progress-threshold)
169 (elmo-display-progress
170 'elmo-localdir-msgdb-create-as-numbers "Creating msgdb..."
172 (setq numbers (cdr numbers)))
173 (message "Creating msgdb...done")
176 (luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder)
178 (elmo-mapcar-list-of-list
179 (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
180 (elmo-list-subdirectories
181 (elmo-localdir-folder-path folder)
182 (or (elmo-localdir-folder-dir-name-internal folder) "")
185 (defsubst elmo-localdir-list-subr (folder &optional nonsort)
186 (let ((flist (mapcar 'string-to-int
188 (elmo-localdir-folder-directory-internal folder)
190 (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))))
192 (cons (or (elmo-max-of-list flist) 0)
195 (elmo-msgdb-killed-list-length killed))
199 (luna-define-method elmo-folder-append-buffer ((folder elmo-localdir-folder)
200 &optional flags number)
201 (let ((filename (elmo-message-file-name
204 (1+ (car (elmo-folder-status folder)))))))
205 (when (and (file-writable-p filename)
206 (not (file-exists-p filename)))
207 (write-region-as-binary
208 (point-min) (point-max) filename nil 'no-msg)
209 (let* ((path (elmo-folder-msgdb-path folder))
210 (table (elmo-flag-table-load path))
211 (msgid (std11-field-body "message-id")))
213 (elmo-flag-table-set table msgid flags)
214 (elmo-flag-table-save path table)))
217 (luna-define-method elmo-folder-append-messages :around
218 ((folder elmo-localdir-folder)
219 src-folder numbers &optional same-number)
220 (if (elmo-folder-message-file-p src-folder)
221 (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
222 (dir (elmo-localdir-folder-directory-internal folder))
223 (table (elmo-flag-table-load (elmo-folder-msgdb-path folder)))
225 (next-num (1+ (car (elmo-folder-status folder))))
228 (setq flags (elmo-message-flags src-folder (car numbers)))
230 (elmo-message-file-name src-folder (car numbers))
233 (if same-number (car numbers) next-num))
235 ;; save flag-table only when src folder's msgdb is loaded.
236 (when (setq id (and src-msgdb-exists
237 (elmo-message-field src-folder (car numbers)
239 (elmo-flag-table-set table id flags))
240 (elmo-progress-notify 'elmo-folder-move-messages)
241 (if (and (setq numbers (cdr numbers))
244 (if (elmo-localdir-locked-p)
246 (1+ (car (elmo-folder-status folder)))
248 (when (elmo-folder-persistent-p folder)
249 (elmo-flag-table-save (elmo-folder-msgdb-path folder) table))
251 (luna-call-next-method)))
253 (luna-define-method elmo-folder-delete-messages ((folder elmo-localdir-folder)
255 (dolist (number numbers)
256 (elmo-localdir-delete-message folder number))
259 (defun elmo-localdir-delete-message (folder number)
260 "Delete message in the FOLDER with NUMBER."
261 (let ((filename (elmo-message-file-name folder number)))
262 (when (and (string-match "[0-9]+" filename) ; for safety.
263 (file-exists-p filename)
264 (file-writable-p filename)
265 (not (file-directory-p filename)))
266 (delete-file filename)
269 (luna-define-method elmo-message-fetch-internal ((folder elmo-localdir-folder)
271 &optional section unread)
272 (when (file-exists-p (elmo-message-file-name folder number))
273 (insert-file-contents-as-binary
274 (elmo-message-file-name folder number))))
276 (luna-define-method elmo-folder-list-messages-internal
277 ((folder elmo-localdir-folder) &optional nohide)
278 (elmo-localdir-list-subr folder))
280 (luna-define-method elmo-folder-status ((folder elmo-localdir-folder))
281 (elmo-localdir-list-subr folder t))
283 (luna-define-method elmo-folder-creatable-p ((folder elmo-localdir-folder))
286 (luna-define-method elmo-folder-writable-p ((folder elmo-localdir-folder))
289 (luna-define-method elmo-folder-create ((folder elmo-localdir-folder))
290 (let ((dir (elmo-localdir-folder-directory-internal folder)))
291 (if (file-directory-p dir)
293 (if (file-exists-p dir)
294 (error "Create folder failed")
295 (elmo-make-directory dir))
298 (luna-define-method elmo-folder-delete ((folder elmo-localdir-folder))
299 (let ((msgs (and (elmo-folder-exists-p folder)
300 (elmo-folder-list-messages folder))))
301 (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
302 (if (> (length msgs) 0)
303 (format "%d msg(s) exists. " (length msgs))
305 (elmo-folder-name-internal folder)))
306 (let ((dir (elmo-localdir-folder-directory-internal folder)))
307 (if (not (file-directory-p dir))
308 (error "No such directory: %s" dir)
309 (elmo-delete-match-files dir "[0-9]+" t)))
310 (elmo-msgdb-delete-path folder)
313 (luna-define-method elmo-folder-rename-internal ((folder elmo-localdir-folder)
315 (let* ((old (elmo-localdir-folder-directory-internal folder))
316 (new (elmo-localdir-folder-directory-internal new-folder))
317 (new-dir (directory-file-name (file-name-directory new))))
318 (unless (file-directory-p old)
319 (error "No such directory: %s" old))
320 (when (file-exists-p new)
321 (error "Already exists directory: %s" new))
322 (unless (file-directory-p new-dir)
323 (elmo-make-directory new-dir))
324 (rename-file old new)
327 (defsubst elmo-localdir-field-condition-match (folder condition
329 (elmo-file-field-condition-match
330 (expand-file-name (int-to-string number)
331 (elmo-localdir-folder-directory-internal folder))
332 condition number number-list))
334 (luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder))
335 (let* ((dir (elmo-localdir-folder-directory-internal folder))
336 (msgdb (elmo-folder-msgdb folder))
337 (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
338 (numbers (sort (elmo-folder-list-messages
341 (not elmo-pack-number-check-strict))
343 (new-number 1) ; first ordinal position in localdir
345 (setq total (length numbers))
346 (elmo-with-progress-display (> total elmo-display-progress-threshold)
347 (elmo-folder-pack-numbers total "Packing...")
348 (dolist (old-number numbers)
349 (setq entity (elmo-msgdb-message-entity msgdb old-number))
350 (when (not (eq old-number new-number)) ; why \=() is wrong..
354 (rename-file (int-to-string old-number)
355 (int-to-string new-number) t))
356 (elmo-message-entity-set-number entity new-number))
357 (elmo-msgdb-append-entity new-msgdb entity
358 (elmo-msgdb-flags msgdb old-number))
359 (setq new-number (1+ new-number))))
360 (message "Packing...done")
361 (elmo-folder-set-msgdb-internal folder new-msgdb)))
363 (luna-define-method elmo-folder-message-file-p ((folder elmo-localdir-folder))
366 (luna-define-method elmo-message-file-name ((folder elmo-localdir-folder)
369 (int-to-string number)
370 (elmo-localdir-folder-directory-internal folder)))
372 (defun elmo-localdir-locked-p ()
373 (if elmo-localdir-lockfile-list
374 (let ((lock elmo-localdir-lockfile-list))
377 (if (file-exists-p (car lock))
379 (setq lock (cdr lock)))))))
381 (autoload 'elmo-global-flags-set "elmo-flag")
384 (product-provide (provide 'elmo-localdir) (require 'elmo-version))
386 ;;; elmo-localdir.el ends here