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 ;;; ELMO Maildir folder
40 (luna-define-class elmo-maildir-folder
42 (directory unread-locations flagged-locations))
43 (luna-define-internal-accessors 'elmo-maildir-folder))
45 (luna-define-method elmo-folder-initialize ((folder
48 (if (file-name-absolute-p name)
49 (elmo-maildir-folder-set-directory-internal
51 (expand-file-name name))
52 (elmo-maildir-folder-set-directory-internal
56 elmo-maildir-folder-path)))
59 (luna-define-method elmo-folder-expand-msgdb-path ((folder
62 (elmo-replace-string-as-filename
63 (elmo-maildir-folder-directory-internal folder))
68 (defun elmo-maildir-message-file-name (folder location)
69 "Get a file name of the message from FOLDER which corresponded to
71 (let ((file (file-name-completion
75 (elmo-maildir-folder-directory-internal folder)))))
78 (if (eq file t) location file)
81 (elmo-maildir-folder-directory-internal folder))))))
83 (defsubst elmo-maildir-list-location (dir &optional child-dir)
84 (let* ((cur-dir (expand-file-name (or child-dir "cur") dir))
85 (cur (directory-files cur-dir
87 unread-locations flagged-locations seen flagged sym
92 (if (string-match "^\\([^:]+\\):\\([^:]+\\)$" x)
97 ((string-match "S" (elmo-match-string 2 x))
99 ((string-match "F" (elmo-match-string 2 x))
101 (setq sym (elmo-match-string 1 x))
102 (unless seen (setq unread-locations
103 (cons sym unread-locations)))
104 (if flagged (setq flagged-locations
105 (cons sym flagged-locations)))
109 (list locations unread-locations flagged-locations)))
111 (luna-define-method elmo-map-folder-list-message-locations
112 ((folder elmo-maildir-folder))
113 (elmo-maildir-update-current folder)
114 (let ((locs (elmo-maildir-list-location
115 (elmo-maildir-folder-directory-internal folder))))
116 ;; 0: locations, 1: unread-locations, 2: flagged-locations
117 (elmo-maildir-folder-set-unread-locations-internal folder (nth 1 locs))
118 (elmo-maildir-folder-set-flagged-locations-internal folder (nth 2 locs))
121 (luna-define-method elmo-map-folder-list-unreads
122 ((folder elmo-maildir-folder))
123 (elmo-maildir-folder-unread-locations-internal folder))
125 (luna-define-method elmo-map-folder-list-importants
126 ((folder elmo-maildir-folder))
127 (elmo-maildir-folder-flagged-locations-internal folder))
129 (luna-define-method elmo-folder-msgdb-create
130 ((folder elmo-maildir-folder)
131 numbers new-mark already-mark seen-mark important-mark seen-list)
132 (let* ((unread-list (elmo-maildir-folder-unread-locations-internal folder))
133 (flagged-list (elmo-maildir-folder-flagged-locations-internal folder))
134 (len (length numbers))
136 overview number-alist mark-alist entity
138 (message "Creating msgdb...")
141 (setq location (elmo-map-message-location folder number))
143 (elmo-msgdb-create-overview-entity-from-file
145 (elmo-maildir-message-file-name folder location)))
148 (elmo-msgdb-append-element overview entity))
150 (elmo-msgdb-number-add number-alist
151 (elmo-msgdb-overview-entity-get-number
153 (elmo-msgdb-overview-entity-get-id
156 ((member location unread-list)
157 (setq mark new-mark)) ; unread!
158 ((member location flagged-list)
159 (setq mark important-mark)))
161 (elmo-msgdb-mark-append
163 (elmo-msgdb-overview-entity-get-number
165 (or (elmo-msgdb-global-mark-get
166 (elmo-msgdb-overview-entity-get-id
169 (when (> len elmo-display-progress-threshold)
171 (elmo-display-progress
172 'elmo-maildir-msgdb-create "Creating msgdb..."
173 (/ (* i 100) len)))))
174 (message "Creating msgdb...done")
175 (elmo-msgdb-sort-by-date
176 (list overview number-alist mark-alist))))
178 (defun elmo-maildir-cleanup-temporal (dir)
179 ;; Delete files in the tmp dir which are not accessed
180 ;; for more than 36 hours.
181 (let ((cur-time (current-time))
186 (setq last-accessed (nth 4 (file-attributes file)))
187 (when (or (> (- (car cur-time)(car last-accessed)) 1)
188 (and (eq (- (car cur-time)(car last-accessed)) 1)
189 (> (- (cadr cur-time)(cadr last-accessed))
191 (message "Maildir: %d tmp file(s) are cleared."
192 (setq count (1+ count)))
193 (delete-file file))))
194 (directory-files (expand-file-name "tmp" dir)
198 (defun elmo-maildir-update-current (folder)
199 "Move all new msgs to cur in the maildir."
200 (let* ((maildir (elmo-maildir-folder-directory-internal folder))
201 (news (directory-files (expand-file-name "new"
205 ;; cleanup tmp directory.
206 (elmo-maildir-cleanup-temporal maildir)
207 ;; move new msgs to cur directory.
210 (expand-file-name (car news) (expand-file-name "new" maildir))
211 (expand-file-name (concat (car news) ":2,")
212 (expand-file-name "cur" maildir)))
213 (setq news (cdr news)))))
215 (defun elmo-maildir-set-mark (filename mark)
216 "Mark the FILENAME file in the maildir. MARK is a character."
217 (if (string-match "^\\([^:]+:[12],\\)\\(.*\\)$" filename)
218 (let ((flaglist (string-to-char-list (elmo-match-string
220 (unless (memq mark flaglist)
221 (setq flaglist (sort (cons mark flaglist) '<))
222 (rename-file filename
223 (concat (elmo-match-string 1 filename)
224 (char-list-to-string flaglist)))))
225 ;; Rescue no info file in maildir.
226 (rename-file filename
227 (concat filename ":2," (char-to-string mark))))
230 (defun elmo-maildir-delete-mark (filename mark)
231 "Mark the FILENAME file in the maildir. MARK is a character."
232 (if (string-match "^\\([^:]+:2,\\)\\(.*\\)$" filename)
233 (let ((flaglist (string-to-char-list (elmo-match-string
235 (when (memq mark flaglist)
236 (setq flaglist (delq mark flaglist))
237 (rename-file filename
238 (concat (elmo-match-string 1 filename)
240 (char-list-to-string flaglist))))))))
242 (defsubst elmo-maildir-set-mark-msgs (folder locs mark)
244 (elmo-maildir-set-mark
245 (elmo-maildir-message-file-name folder loc)
249 (defsubst elmo-maildir-delete-mark-msgs (folder locs mark)
251 (elmo-maildir-delete-mark
252 (elmo-maildir-message-file-name folder loc)
256 (luna-define-method elmo-map-folder-mark-as-important ((folder elmo-maildir-folder)
258 (elmo-maildir-set-mark-msgs folder locs ?F))
260 (luna-define-method elmo-map-folder-unmark-important ((folder elmo-maildir-folder)
262 (elmo-maildir-delete-mark-msgs folder locs ?F))
264 (luna-define-method elmo-map-folder-mark-as-read ((folder elmo-maildir-folder)
266 (elmo-maildir-set-mark-msgs folder locs ?S))
268 (luna-define-method elmo-map-folder-unmark-read ((folder elmo-maildir-folder)
270 (elmo-maildir-delete-mark-msgs folder locs ?S))
272 (luna-define-method elmo-folder-list-subfolders
273 ((folder elmo-maildir-folder) &optional one-level)
274 (let ((elmo-list-subdirectories-ignore-regexp
275 "^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$"))
277 (list (elmo-folder-name-internal folder))
279 (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
280 (elmo-list-subdirectories
281 (elmo-maildir-folder-directory-internal folder)
285 (defvar elmo-maildir-sequence-number-internal 0)
288 ((>= emacs-major-version 19)
289 (defun elmo-maildir-make-unique-string ()
290 "This function generates a string that can be used as a unique
291 file name for maildir directories."
292 (let ((cur-time (current-time)))
293 (format "%.0f.%d_%d.%s"
295 (float 65536)) (cadr cur-time))
297 (incf elmo-maildir-sequence-number-internal)
299 ((eq emacs-major-version 18)
300 ;; A fake function for v18
301 (defun elmo-maildir-make-unique-string ()
302 "This function generates a string that can be used as a unique
303 file name for maildir directories."
304 (unless (fboundp 'float-to-string)
305 (load-library "float"))
306 (let ((time (current-time)))
310 (f+ (f* (f (car time))
315 (% (abs (random t)) 10000); dummy pid
318 (defun elmo-maildir-temporal-filename (basedir)
319 (let ((filename (expand-file-name
320 (concat "tmp/" (elmo-maildir-make-unique-string))
322 (unless (file-exists-p (file-name-directory filename))
323 (make-directory (file-name-directory filename)))
324 (while (file-exists-p filename)
325 ;;; I don't want to wait.
329 (concat "tmp/" (elmo-maildir-make-unique-string))
333 (luna-define-method elmo-folder-append-buffer ((folder elmo-maildir-folder)
334 unread &optional number)
335 (let ((basedir (elmo-maildir-folder-directory-internal folder))
336 (src-buf (current-buffer))
340 (setq filename (elmo-maildir-temporal-filename basedir))
341 (setq dst-buf (current-buffer))
342 (with-current-buffer src-buf
343 (copy-to-buffer dst-buf (point-min) (point-max)))
344 (as-binary-output-file
345 (write-region (point-min) (point-max) filename nil 'no-msg))
346 ;; add link from new.
347 (elmo-add-name-to-file
350 (concat "new/" (file-name-nondirectory filename))
353 ;; If an error occured, return nil.
356 (luna-define-method elmo-folder-message-file-p ((folder elmo-maildir-folder))
359 (luna-define-method elmo-message-file-name ((folder elmo-maildir-folder)
361 (elmo-maildir-message-file-name
363 (elmo-map-message-location folder number)))
365 (luna-define-method elmo-folder-message-make-temp-file-p
366 ((folder elmo-maildir-folder))
369 (luna-define-method elmo-folder-message-make-temp-files ((folder
374 (let ((temp-dir (elmo-folder-make-temp-dir folder))
375 (cur-number (if start-number 0)))
376 (dolist (number numbers)
378 (elmo-message-file-name folder number)
380 (int-to-string (if start-number (incf cur-number) number))
384 (luna-define-method elmo-folder-append-messages :around
385 ((folder elmo-maildir-folder)
386 src-folder numbers unread-marks &optional same-number)
387 (if (elmo-folder-message-file-p src-folder)
388 (let ((dir (elmo-maildir-folder-directory-internal folder))
391 (setq filename (elmo-maildir-temporal-filename dir))
392 (dolist (number numbers)
394 (elmo-message-file-name src-folder number)
396 (elmo-add-name-to-file
399 (concat "new/" (file-name-nondirectory filename))
402 (luna-call-next-method)))
404 (luna-define-method elmo-map-folder-delete-messages
405 ((folder elmo-maildir-folder) locations)
407 (dolist (location locations)
408 (setq file (elmo-maildir-message-file-name folder location))
410 (file-writable-p file)
411 (not (file-directory-p file)))
412 (delete-file file)))))
414 (luna-define-method elmo-map-message-fetch ((folder elmo-maildir-folder)
415 location strategy &optional
416 section outbuf unseen)
417 (let ((file (elmo-maildir-message-file-name folder location)))
418 (when (file-exists-p file)
420 (with-current-buffer outbuf
422 (insert-file-contents-as-binary file)
423 (elmo-delete-cr-buffer)
426 (insert-file-contents-as-binary file)
427 (elmo-delete-cr-buffer)
430 (luna-define-method elmo-folder-exists-p ((folder elmo-maildir-folder))
431 (let ((basedir (elmo-maildir-folder-directory-internal folder)))
432 (and (file-directory-p (expand-file-name "new" basedir))
433 (file-directory-p (expand-file-name "cur" basedir))
434 (file-directory-p (expand-file-name "tmp" basedir)))))
436 (luna-define-method elmo-folder-diff ((folder elmo-maildir-folder)
438 (let* ((dir (elmo-maildir-folder-directory-internal folder))
439 (new-len (length (car (elmo-maildir-list-location dir "new"))))
440 (cur-len (length (car (elmo-maildir-list-location dir "cur")))))
441 (cons new-len (+ new-len cur-len))))
443 (luna-define-method elmo-folder-creatable-p ((folder elmo-maildir-folder))
446 (luna-define-method elmo-folder-create ((folder elmo-maildir-folder))
447 (let ((basedir (elmo-maildir-folder-directory-internal folder)))
450 (dolist (dir '("." "new" "cur" "tmp"))
451 (setq dir (expand-file-name dir basedir))
452 (or (file-directory-p dir)
454 (elmo-make-directory dir)
455 (set-file-modes dir 448))))
459 (luna-define-method elmo-folder-delete ((folder elmo-maildir-folder))
460 (let ((basedir (elmo-maildir-folder-directory-internal folder)))
462 (let ((tmp-files (directory-files
463 (expand-file-name "tmp" basedir)
465 ;; Delete files in tmp.
466 (dolist (file tmp-files)
468 (dolist (dir '("new" "cur" "tmp" "."))
469 (setq dir (expand-file-name dir basedir))
470 (if (not (file-directory-p dir))
472 (elmo-delete-directory dir t)))
476 (luna-define-method elmo-folder-search ((folder elmo-maildir-folder)
477 condition &optional numbers)
479 (let* ((msgs (or numbers (elmo-folder-list-messages folder)))
481 case-fold-search matches
485 (setq number-list msgs)
486 (dolist (number numbers)
487 (if (elmo-file-field-condition-match
488 (elmo-message-file-name folder number)
489 condition number number-list)
490 (setq matches (cons number matches)))
492 (elmo-display-progress
493 'elmo-maildir-search "Searching..."
495 (nreverse matches))))
498 (product-provide (provide 'elmo-maildir) (require 'elmo-version))
500 ;;; elmo-maildir.el ends here