1 ;;; elmo-maildir.el --- Maildir interface for ELMO.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
32 (eval-when-compile (require 'cl))
38 (defcustom elmo-maildir-folder-path "~/Maildir"
39 "*Maildir folder path."
43 ;;; ELMO Maildir folder
45 (luna-define-class elmo-maildir-folder
47 (directory unread-locations flagged-locations))
48 (luna-define-internal-accessors 'elmo-maildir-folder))
50 (luna-define-method elmo-folder-initialize ((folder
53 (if (file-name-absolute-p name)
54 (elmo-maildir-folder-set-directory-internal
56 (expand-file-name name))
57 (elmo-maildir-folder-set-directory-internal
61 elmo-maildir-folder-path)))
64 (luna-define-method elmo-folder-expand-msgdb-path ((folder
67 (elmo-replace-string-as-filename
68 (elmo-maildir-folder-directory-internal folder))
71 elmo-msgdb-directory)))
73 (defun elmo-maildir-message-file-name (folder location)
74 "Get a file name of the message from FOLDER which corresponded to
76 (let ((file (file-name-completion
80 (elmo-maildir-folder-directory-internal folder)))))
83 (if (eq file t) location file)
86 (elmo-maildir-folder-directory-internal folder))))))
88 (defsubst elmo-maildir-list-location (dir &optional child-dir)
89 (let* ((cur-dir (expand-file-name (or child-dir "cur") dir))
90 (cur (directory-files cur-dir
92 unread-locations flagged-locations seen flagged sym
97 (if (string-match "^\\([^:]+\\):\\([^:]+\\)$" x)
102 ((string-match "S" (elmo-match-string 2 x))
104 ((string-match "F" (elmo-match-string 2 x))
106 (setq sym (elmo-match-string 1 x))
107 (unless seen (setq unread-locations
108 (cons sym unread-locations)))
109 (if flagged (setq flagged-locations
110 (cons sym flagged-locations)))
114 (list locations unread-locations flagged-locations)))
116 (luna-define-method elmo-map-folder-list-message-locations
117 ((folder elmo-maildir-folder))
118 (elmo-maildir-update-current folder)
119 (let ((locs (elmo-maildir-list-location
120 (elmo-maildir-folder-directory-internal folder))))
121 ;; 0: locations, 1: unread-locations, 2: flagged-locations
122 (elmo-maildir-folder-set-unread-locations-internal folder (nth 1 locs))
123 (elmo-maildir-folder-set-flagged-locations-internal folder (nth 2 locs))
126 (luna-define-method elmo-map-folder-list-unreads
127 ((folder elmo-maildir-folder))
128 (elmo-maildir-folder-unread-locations-internal folder))
130 (luna-define-method elmo-map-folder-list-importants
131 ((folder elmo-maildir-folder))
132 (elmo-maildir-folder-flagged-locations-internal folder))
134 (luna-define-method elmo-folder-msgdb-create
135 ((folder elmo-maildir-folder) numbers seen-list)
136 (let* ((unread-list (elmo-maildir-folder-unread-locations-internal folder))
137 (flagged-list (elmo-maildir-folder-flagged-locations-internal folder))
138 (len (length numbers))
140 overview number-alist mark-alist entity
142 (message "Creating msgdb...")
145 (setq location (elmo-map-message-location folder number))
147 (elmo-msgdb-create-overview-entity-from-file
149 (elmo-maildir-message-file-name folder location)))
152 (elmo-msgdb-append-element overview entity))
154 (elmo-msgdb-number-add number-alist
155 (elmo-msgdb-overview-entity-get-number
157 (elmo-msgdb-overview-entity-get-id
160 ((member location unread-list)
161 (setq mark elmo-msgdb-new-mark)) ; unread!
162 ((member location flagged-list)
163 (setq mark elmo-msgdb-important-mark)))
164 (if (setq mark (or (elmo-msgdb-global-mark-get
165 (elmo-msgdb-overview-entity-get-id
169 (elmo-msgdb-mark-append
171 (elmo-msgdb-overview-entity-get-number
174 (when (> len elmo-display-progress-threshold)
176 (elmo-display-progress
177 'elmo-maildir-msgdb-create "Creating msgdb..."
178 (/ (* i 100) len)))))
179 (message "Creating msgdb...done")
180 (elmo-msgdb-sort-by-date
181 (list overview number-alist mark-alist))))
183 (defun elmo-maildir-cleanup-temporal (dir)
184 ;; Delete files in the tmp dir which are not accessed
185 ;; for more than 36 hours.
186 (let ((cur-time (current-time))
191 (setq last-accessed (nth 4 (file-attributes file)))
192 (when (or (> (- (car cur-time)(car last-accessed)) 1)
193 (and (eq (- (car cur-time)(car last-accessed)) 1)
194 (> (- (cadr cur-time)(cadr last-accessed))
196 (message "Maildir: %d tmp file(s) are cleared."
197 (setq count (1+ count)))
198 (delete-file file))))
199 (directory-files (expand-file-name "tmp" dir)
203 (defun elmo-maildir-update-current (folder)
204 "Move all new msgs to cur in the maildir."
205 (let* ((maildir (elmo-maildir-folder-directory-internal folder))
206 (news (directory-files (expand-file-name "new"
210 ;; cleanup tmp directory.
211 (elmo-maildir-cleanup-temporal maildir)
212 ;; move new msgs to cur directory.
215 (expand-file-name (car news) (expand-file-name "new" maildir))
216 (expand-file-name (concat
218 (unless (string-match ":2,[A-Z]*$" (car news))
220 (expand-file-name "cur" maildir)))
221 (setq news (cdr news)))))
223 (defun elmo-maildir-set-mark (filename mark)
224 "Mark the FILENAME file in the maildir. MARK is a character."
225 (if (string-match "^\\([^:]+:[12],\\)\\(.*\\)$" filename)
226 (let ((flaglist (string-to-char-list (elmo-match-string
228 (unless (memq mark flaglist)
229 (setq flaglist (sort (cons mark flaglist) '<))
230 (rename-file filename
231 (concat (elmo-match-string 1 filename)
232 (char-list-to-string flaglist)))))
233 ;; Rescue no info file in maildir.
234 (rename-file filename
235 (concat filename ":2," (char-to-string mark))))
238 (defun elmo-maildir-delete-mark (filename mark)
239 "Mark the FILENAME file in the maildir. MARK is a character."
240 (if (string-match "^\\([^:]+:2,\\)\\(.*\\)$" filename)
241 (let ((flaglist (string-to-char-list (elmo-match-string
243 (when (memq mark flaglist)
244 (setq flaglist (delq mark flaglist))
245 (rename-file filename
246 (concat (elmo-match-string 1 filename)
248 (char-list-to-string flaglist))))))))
250 (defsubst elmo-maildir-set-mark-msgs (folder locs mark)
252 (elmo-maildir-set-mark
253 (elmo-maildir-message-file-name folder loc)
257 (defsubst elmo-maildir-delete-mark-msgs (folder locs mark)
259 (elmo-maildir-delete-mark
260 (elmo-maildir-message-file-name folder loc)
264 (luna-define-method elmo-map-folder-mark-as-important ((folder elmo-maildir-folder)
266 (elmo-maildir-set-mark-msgs folder locs ?F))
268 (luna-define-method elmo-map-folder-unmark-important ((folder elmo-maildir-folder)
270 (elmo-maildir-delete-mark-msgs folder locs ?F))
272 (luna-define-method elmo-map-folder-mark-as-read ((folder elmo-maildir-folder)
274 (elmo-maildir-set-mark-msgs folder locs ?S))
276 (luna-define-method elmo-map-folder-unmark-read ((folder elmo-maildir-folder)
278 (elmo-maildir-delete-mark-msgs folder locs ?S))
280 (luna-define-method elmo-folder-list-subfolders
281 ((folder elmo-maildir-folder) &optional one-level)
282 (let ((prefix (concat (elmo-folder-name-internal folder)
283 (unless (string= (elmo-folder-prefix-internal folder)
284 (elmo-folder-name-internal folder))
286 (elmo-list-subdirectories-ignore-regexp
287 "^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$")
288 elmo-have-link-count)
290 (list (elmo-folder-name-internal folder))
291 (elmo-mapcar-list-of-list
292 (function (lambda (x) (concat prefix x)))
293 (elmo-list-subdirectories
294 (elmo-maildir-folder-directory-internal folder)
298 (defvar elmo-maildir-sequence-number-internal 0)
301 ((>= emacs-major-version 19)
302 (defun elmo-maildir-make-unique-string ()
303 "This function generates a string that can be used as a unique
304 file name for maildir directories."
305 (let ((cur-time (current-time)))
306 (format "%.0f.%d_%d.%s"
308 (float 65536)) (cadr cur-time))
310 (incf elmo-maildir-sequence-number-internal)
312 ((eq emacs-major-version 18)
313 ;; A fake function for v18
314 (defun elmo-maildir-make-unique-string ()
315 "This function generates a string that can be used as a unique
316 file name for maildir directories."
317 (unless (fboundp 'float-to-string)
318 (load-library "float"))
319 (let ((time (current-time)))
323 (f+ (f* (f (car time))
328 (% (abs (random t)) 10000); dummy pid
331 (defun elmo-maildir-temporal-filename (basedir)
332 (let ((filename (expand-file-name
333 (concat "tmp/" (elmo-maildir-make-unique-string))
335 (unless (file-exists-p (file-name-directory filename))
336 (make-directory (file-name-directory filename)))
337 (while (file-exists-p filename)
338 ;;; I don't want to wait.
342 (concat "tmp/" (elmo-maildir-make-unique-string))
346 (luna-define-method elmo-folder-append-buffer ((folder elmo-maildir-folder)
347 unread &optional number)
348 (let ((basedir (elmo-maildir-folder-directory-internal folder))
349 (src-buf (current-buffer))
353 (setq filename (elmo-maildir-temporal-filename basedir))
354 (setq dst-buf (current-buffer))
355 (with-current-buffer src-buf
356 (copy-to-buffer dst-buf (point-min) (point-max)))
357 (as-binary-output-file
358 (write-region (point-min) (point-max) filename nil 'no-msg))
359 ;; add link from new.
360 (elmo-add-name-to-file
363 (concat "new/" (file-name-nondirectory filename))
366 ;; If an error occured, return nil.
369 (luna-define-method elmo-folder-message-file-p ((folder elmo-maildir-folder))
372 (luna-define-method elmo-message-file-name ((folder elmo-maildir-folder)
374 (elmo-maildir-message-file-name
376 (elmo-map-message-location folder number)))
378 (luna-define-method elmo-folder-message-make-temp-file-p
379 ((folder elmo-maildir-folder))
382 (luna-define-method elmo-folder-message-make-temp-files ((folder
387 (let ((temp-dir (elmo-folder-make-temporary-directory folder))
388 (cur-number (if start-number 0)))
389 (dolist (number numbers)
391 (elmo-message-file-name folder number)
393 (int-to-string (if start-number (incf cur-number) number))
397 (luna-define-method elmo-folder-append-messages :around
398 ((folder elmo-maildir-folder)
399 src-folder numbers &optional same-number)
400 (if (elmo-folder-message-file-p src-folder)
401 (let ((dir (elmo-maildir-folder-directory-internal folder))
404 (dolist (number numbers)
405 (setq filename (elmo-maildir-temporal-filename dir))
407 (elmo-message-file-name src-folder number)
409 (elmo-add-name-to-file
412 (concat "new/" (file-name-nondirectory filename))
414 (elmo-progress-notify 'elmo-folder-move-messages))
416 (luna-call-next-method)))
418 (luna-define-method elmo-map-folder-delete-messages
419 ((folder elmo-maildir-folder) locations)
421 (dolist (location locations)
422 (setq file (elmo-maildir-message-file-name folder location))
424 (file-writable-p file)
425 (not (file-directory-p file)))
426 (delete-file file)))))
428 (luna-define-method elmo-map-message-fetch ((folder elmo-maildir-folder)
430 &optional section unseen)
431 (let ((file (elmo-maildir-message-file-name folder location)))
432 (when (file-exists-p file)
433 (insert-file-contents-as-binary file))))
435 (luna-define-method elmo-folder-exists-p ((folder elmo-maildir-folder))
436 (let ((basedir (elmo-maildir-folder-directory-internal folder)))
437 (and (file-directory-p (expand-file-name "new" basedir))
438 (file-directory-p (expand-file-name "cur" basedir))
439 (file-directory-p (expand-file-name "tmp" basedir)))))
441 (luna-define-method elmo-folder-diff ((folder elmo-maildir-folder)
443 (let* ((dir (elmo-maildir-folder-directory-internal folder))
444 (new-len (length (car (elmo-maildir-list-location dir "new"))))
445 (cur-len (length (car (elmo-maildir-list-location dir "cur")))))
446 (cons new-len (+ new-len cur-len))))
448 (luna-define-method elmo-folder-creatable-p ((folder elmo-maildir-folder))
451 (luna-define-method elmo-folder-writable-p ((folder elmo-maildir-folder))
454 (luna-define-method elmo-folder-create ((folder elmo-maildir-folder))
455 (let ((basedir (elmo-maildir-folder-directory-internal folder)))
458 (dolist (dir '("." "new" "cur" "tmp"))
459 (setq dir (expand-file-name dir basedir))
460 (or (file-directory-p dir)
462 (elmo-make-directory dir)
463 (set-file-modes dir 448))))
467 (luna-define-method elmo-folder-delete :before ((folder elmo-maildir-folder))
468 (let ((basedir (elmo-maildir-folder-directory-internal folder)))
470 (let ((tmp-files (directory-files
471 (expand-file-name "tmp" basedir)
473 ;; Delete files in tmp.
474 (dolist (file tmp-files)
476 (dolist (dir '("new" "cur" "tmp" "."))
477 (setq dir (expand-file-name dir basedir))
478 (if (not (file-directory-p dir))
480 (elmo-delete-directory dir t)))
485 (product-provide (provide 'elmo-maildir) (require 'elmo-version))
487 ;;; elmo-maildir.el ends here