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)))
160 (if (setq mark (or (elmo-msgdb-global-mark-get
161 (elmo-msgdb-overview-entity-get-id
165 (elmo-msgdb-mark-append
167 (elmo-msgdb-overview-entity-get-number
170 (when (> len elmo-display-progress-threshold)
172 (elmo-display-progress
173 'elmo-maildir-msgdb-create "Creating msgdb..."
174 (/ (* i 100) len)))))
175 (message "Creating msgdb...done")
176 (elmo-msgdb-sort-by-date
177 (list overview number-alist mark-alist))))
179 (defun elmo-maildir-cleanup-temporal (dir)
180 ;; Delete files in the tmp dir which are not accessed
181 ;; for more than 36 hours.
182 (let ((cur-time (current-time))
187 (setq last-accessed (nth 4 (file-attributes file)))
188 (when (or (> (- (car cur-time)(car last-accessed)) 1)
189 (and (eq (- (car cur-time)(car last-accessed)) 1)
190 (> (- (cadr cur-time)(cadr last-accessed))
192 (message "Maildir: %d tmp file(s) are cleared."
193 (setq count (1+ count)))
194 (delete-file file))))
195 (directory-files (expand-file-name "tmp" dir)
199 (defun elmo-maildir-update-current (folder)
200 "Move all new msgs to cur in the maildir."
201 (let* ((maildir (elmo-maildir-folder-directory-internal folder))
202 (news (directory-files (expand-file-name "new"
206 ;; cleanup tmp directory.
207 (elmo-maildir-cleanup-temporal maildir)
208 ;; move new msgs to cur directory.
211 (expand-file-name (car news) (expand-file-name "new" maildir))
212 (expand-file-name (concat (car news) ":2,")
213 (expand-file-name "cur" maildir)))
214 (setq news (cdr news)))))
216 (defun elmo-maildir-set-mark (filename mark)
217 "Mark the FILENAME file in the maildir. MARK is a character."
218 (if (string-match "^\\([^:]+:[12],\\)\\(.*\\)$" filename)
219 (let ((flaglist (string-to-char-list (elmo-match-string
221 (unless (memq mark flaglist)
222 (setq flaglist (sort (cons mark flaglist) '<))
223 (rename-file filename
224 (concat (elmo-match-string 1 filename)
225 (char-list-to-string flaglist)))))
226 ;; Rescue no info file in maildir.
227 (rename-file filename
228 (concat filename ":2," (char-to-string mark))))
231 (defun elmo-maildir-delete-mark (filename mark)
232 "Mark the FILENAME file in the maildir. MARK is a character."
233 (if (string-match "^\\([^:]+:2,\\)\\(.*\\)$" filename)
234 (let ((flaglist (string-to-char-list (elmo-match-string
236 (when (memq mark flaglist)
237 (setq flaglist (delq mark flaglist))
238 (rename-file filename
239 (concat (elmo-match-string 1 filename)
241 (char-list-to-string flaglist))))))))
243 (defsubst elmo-maildir-set-mark-msgs (folder locs mark)
245 (elmo-maildir-set-mark
246 (elmo-maildir-message-file-name folder loc)
250 (defsubst elmo-maildir-delete-mark-msgs (folder locs mark)
252 (elmo-maildir-delete-mark
253 (elmo-maildir-message-file-name folder loc)
257 (luna-define-method elmo-map-folder-mark-as-important ((folder elmo-maildir-folder)
259 (elmo-maildir-set-mark-msgs folder locs ?F))
261 (luna-define-method elmo-map-folder-unmark-important ((folder elmo-maildir-folder)
263 (elmo-maildir-delete-mark-msgs folder locs ?F))
265 (luna-define-method elmo-map-folder-mark-as-read ((folder elmo-maildir-folder)
267 (elmo-maildir-set-mark-msgs folder locs ?S))
269 (luna-define-method elmo-map-folder-unmark-read ((folder elmo-maildir-folder)
271 (elmo-maildir-delete-mark-msgs folder locs ?S))
273 (luna-define-method elmo-folder-list-subfolders
274 ((folder elmo-maildir-folder) &optional one-level)
275 (let ((elmo-list-subdirectories-ignore-regexp
276 "^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$"))
278 (list (elmo-folder-name-internal folder))
280 (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
281 (elmo-list-subdirectories
282 (elmo-maildir-folder-directory-internal folder)
286 (defvar elmo-maildir-sequence-number-internal 0)
289 ((>= emacs-major-version 19)
290 (defun elmo-maildir-make-unique-string ()
291 "This function generates a string that can be used as a unique
292 file name for maildir directories."
293 (let ((cur-time (current-time)))
294 (format "%.0f.%d_%d.%s"
296 (float 65536)) (cadr cur-time))
298 (incf elmo-maildir-sequence-number-internal)
300 ((eq emacs-major-version 18)
301 ;; A fake function for v18
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 (unless (fboundp 'float-to-string)
306 (load-library "float"))
307 (let ((time (current-time)))
311 (f+ (f* (f (car time))
316 (% (abs (random t)) 10000); dummy pid
319 (defun elmo-maildir-temporal-filename (basedir)
320 (let ((filename (expand-file-name
321 (concat "tmp/" (elmo-maildir-make-unique-string))
323 (unless (file-exists-p (file-name-directory filename))
324 (make-directory (file-name-directory filename)))
325 (while (file-exists-p filename)
326 ;;; I don't want to wait.
330 (concat "tmp/" (elmo-maildir-make-unique-string))
334 (luna-define-method elmo-folder-append-buffer ((folder elmo-maildir-folder)
335 unread &optional number)
336 (let ((basedir (elmo-maildir-folder-directory-internal folder))
337 (src-buf (current-buffer))
341 (setq filename (elmo-maildir-temporal-filename basedir))
342 (setq dst-buf (current-buffer))
343 (with-current-buffer src-buf
344 (copy-to-buffer dst-buf (point-min) (point-max)))
345 (as-binary-output-file
346 (write-region (point-min) (point-max) filename nil 'no-msg))
347 ;; add link from new.
348 (elmo-add-name-to-file
351 (concat "new/" (file-name-nondirectory filename))
354 ;; If an error occured, return nil.
357 (luna-define-method elmo-folder-message-file-p ((folder elmo-maildir-folder))
360 (luna-define-method elmo-message-file-name ((folder elmo-maildir-folder)
362 (elmo-maildir-message-file-name
364 (elmo-map-message-location folder number)))
366 (luna-define-method elmo-folder-message-make-temp-file-p
367 ((folder elmo-maildir-folder))
370 (luna-define-method elmo-folder-message-make-temp-files ((folder
375 (let ((temp-dir (elmo-folder-make-temp-dir folder))
376 (cur-number (if start-number 0)))
377 (dolist (number numbers)
379 (elmo-message-file-name folder number)
381 (int-to-string (if start-number (incf cur-number) number))
385 (luna-define-method elmo-folder-append-messages :around
386 ((folder elmo-maildir-folder)
387 src-folder numbers unread-marks &optional same-number)
388 (if (elmo-folder-message-file-p src-folder)
389 (let ((dir (elmo-maildir-folder-directory-internal folder))
392 (setq filename (elmo-maildir-temporal-filename dir))
393 (dolist (number numbers)
395 (elmo-message-file-name src-folder number)
397 (elmo-add-name-to-file
400 (concat "new/" (file-name-nondirectory filename))
403 (luna-call-next-method)))
405 (luna-define-method elmo-map-folder-delete-messages
406 ((folder elmo-maildir-folder) locations)
408 (dolist (location locations)
409 (setq file (elmo-maildir-message-file-name folder location))
411 (file-writable-p file)
412 (not (file-directory-p file)))
413 (delete-file file)))))
415 (luna-define-method elmo-map-message-fetch ((folder elmo-maildir-folder)
416 location strategy &optional
417 section outbuf unseen)
418 (let ((file (elmo-maildir-message-file-name folder location)))
419 (when (file-exists-p file)
421 (with-current-buffer outbuf
423 (insert-file-contents-as-binary file)
424 (elmo-delete-cr-buffer)
427 (insert-file-contents-as-binary file)
428 (elmo-delete-cr-buffer)
431 (luna-define-method elmo-folder-exists-p ((folder elmo-maildir-folder))
432 (let ((basedir (elmo-maildir-folder-directory-internal folder)))
433 (and (file-directory-p (expand-file-name "new" basedir))
434 (file-directory-p (expand-file-name "cur" basedir))
435 (file-directory-p (expand-file-name "tmp" basedir)))))
437 (luna-define-method elmo-folder-diff ((folder elmo-maildir-folder)
439 (let* ((dir (elmo-maildir-folder-directory-internal folder))
440 (new-len (length (car (elmo-maildir-list-location dir "new"))))
441 (cur-len (length (car (elmo-maildir-list-location dir "cur")))))
442 (cons new-len (+ new-len cur-len))))
444 (luna-define-method elmo-folder-creatable-p ((folder elmo-maildir-folder))
447 (luna-define-method elmo-folder-create ((folder elmo-maildir-folder))
448 (let ((basedir (elmo-maildir-folder-directory-internal folder)))
451 (dolist (dir '("." "new" "cur" "tmp"))
452 (setq dir (expand-file-name dir basedir))
453 (or (file-directory-p dir)
455 (elmo-make-directory dir)
456 (set-file-modes dir 448))))
460 (luna-define-method elmo-folder-delete ((folder elmo-maildir-folder))
461 (let ((basedir (elmo-maildir-folder-directory-internal folder)))
463 (let ((tmp-files (directory-files
464 (expand-file-name "tmp" basedir)
466 ;; Delete files in tmp.
467 (dolist (file tmp-files)
469 (dolist (dir '("new" "cur" "tmp" "."))
470 (setq dir (expand-file-name dir basedir))
471 (if (not (file-directory-p dir))
473 (elmo-delete-directory dir t)))
477 (luna-define-method elmo-folder-search ((folder elmo-maildir-folder)
478 condition &optional numbers)
480 (let* ((msgs (or numbers (elmo-folder-list-messages folder)))
482 case-fold-search matches
486 (setq number-list msgs)
487 (dolist (number numbers)
488 (if (elmo-file-field-condition-match
489 (elmo-message-file-name folder number)
490 condition number number-list)
491 (setq matches (cons number matches)))
493 (elmo-display-progress
494 'elmo-maildir-search "Searching..."
496 (nreverse matches))))
499 (product-provide (provide 'elmo-maildir) (require 'elmo-version))
501 ;;; elmo-maildir.el ends here