1 ;;; elmo-maildir.el -- Maildir interface for ELMO.
3 ;; Copyright 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))
34 (require 'elmo-localdir)
36 (defvar elmo-maildir-sequence-number-internal 0
37 "Sequence number for the pid part of unique filename.
38 This variable should not be used in elsewhere.")
40 (defsubst elmo-maildir-get-folder-directory (spec)
41 (if (file-name-absolute-p (nth 1 spec))
42 (nth 1 spec) ; already full path.
43 (expand-file-name (nth 1 spec)
44 elmo-maildir-folder-path)))
46 (defun elmo-maildir-number-to-filename (dir number loc-alist)
47 (let ((location (cdr (assq number loc-alist))))
48 (and location (elmo-maildir-get-filename location dir))))
50 (defun elmo-maildir-get-filename (location dir)
51 "Get a filename that is corresponded to LOCATION in DIR."
53 (let ((file (file-name-completion (symbol-name location)
54 (expand-file-name "cur" dir))))
55 (if (eq file t) (symbol-name location) file))
56 (expand-file-name "cur" dir)))
58 (defsubst elmo-maildir-list-location (dir &optional child-dir)
59 (let* ((cur-dir (expand-file-name (or child-dir "cur") dir))
60 (cur (directory-files cur-dir
62 seen-list seen sym list)
66 (if (string-match "^\\([^:]+\\):\\([^:]+\\)$" x)
72 (elmo-match-string 2 x))
74 (setq sym (intern (elmo-match-string 1 x)))
76 (setq seen-list (cons sym seen-list)))
80 (cons list seen-list)))
82 (defun elmo-maildir-msgdb-create-entity (dir number loc-alist)
83 (elmo-localdir-msgdb-create-overview-entity-from-file
85 (elmo-maildir-number-to-filename dir number loc-alist)))
87 (defun elmo-maildir-cleanup-temporal (dir)
88 ;; Delete files in the tmp dir which are not accessed
89 ;; for more than 36 hours.
90 (let ((cur-time (current-time))
95 (setq last-accessed (nth 4 (file-attributes file)))
96 (when (or (> (- (car cur-time)(car last-accessed)) 1)
97 (and (eq (- (car cur-time)(car last-accessed)) 1)
98 (> (- (cadr cur-time)(cadr last-accessed))
100 (message "Maildir: %d tmp file(s) are cleared."
101 (setq count (1+ count)))
102 (delete-file file))))
103 (directory-files (expand-file-name "tmp" dir)
107 (defun elmo-maildir-update-current (spec)
108 "Move all new msgs to cur in the maildir"
109 (let* ((maildir (elmo-maildir-get-folder-directory spec))
110 (news (directory-files (expand-file-name "new"
114 ;; cleanup tmp directory.
115 (elmo-maildir-cleanup-temporal maildir)
116 ;; move new msgs to cur directory.
119 (expand-file-name (car news) (expand-file-name "new" maildir))
120 (expand-file-name (concat (car news) ":2,")
121 (expand-file-name "cur" maildir)))
122 (setq news (cdr news)))))
124 (defun elmo-maildir-set-mark (filename mark)
125 "Mark the file in the maildir. MARK is a character."
126 (if (string-match "^\\([^:]+:[12],\\)\\(.*\\)$" filename)
127 (let ((flaglist (string-to-char-list (elmo-match-string
129 (unless (memq mark flaglist)
130 (setq flaglist (sort (cons mark flaglist) '<))
131 (rename-file filename
132 (concat (elmo-match-string 1 filename)
133 (char-list-to-string flaglist)))))
134 ;; Rescue no info file in maildir.
135 (rename-file filename
136 (concat filename ":2," (char-to-string mark)))))
138 (defun elmo-maildir-delete-mark (filename mark)
139 "Mark the file in the maildir. MARK is a character."
140 (if (string-match "^\\([^:]+:2,\\)\\(.*\\)$" filename)
141 (let ((flaglist (string-to-char-list (elmo-match-string
143 (when (memq mark flaglist)
144 (setq flaglist (delq mark flaglist))
145 (rename-file filename
146 (concat (elmo-match-string 1 filename)
148 (char-list-to-string flaglist))))))))
150 (defsubst elmo-maildir-set-mark-msgs (spec mark msgs msgdb)
151 (let ((dir (elmo-maildir-get-folder-directory spec))
153 (elmo-msgdb-get-location msgdb)
154 (elmo-msgdb-location-load (elmo-msgdb-expand-path spec))))
157 (if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs))
158 (elmo-maildir-set-mark file mark))
159 (setq msgs (cdr msgs)))))
161 (defsubst elmo-maildir-delete-mark-msgs (spec mark msgs msgdb)
162 (let ((dir (elmo-maildir-get-folder-directory spec))
164 (elmo-msgdb-get-location msgdb)
165 (elmo-msgdb-location-load (elmo-msgdb-expand-path spec))))
168 (if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs))
169 (elmo-maildir-delete-mark file mark))
170 (setq msgs (cdr msgs)))))
172 (defun elmo-maildir-mark-as-important (spec msgs &optional msgdb)
173 (elmo-maildir-set-mark-msgs spec ?F msgs msgdb))
175 (defun elmo-maildir-unmark-important (spec msgs &optional msgdb)
176 (elmo-maildir-delete-mark-msgs spec ?F msgs msgdb))
178 (defun elmo-maildir-mark-as-read (spec msgs &optional msgdb)
179 (elmo-maildir-set-mark-msgs spec ?S msgs msgdb))
181 (defun elmo-maildir-mark-as-unread (spec msgs &optional msgdb)
182 (elmo-maildir-delete-mark-msgs spec ?S msgs msgdb))
184 (defun elmo-maildir-msgdb-create (spec numlist new-mark
185 already-mark seen-mark
190 (let* ((dir (elmo-maildir-get-folder-directory spec))
191 (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
192 (elmo-msgdb-location-load (elmo-msgdb-expand-path
194 (loc-seen (elmo-maildir-list-location dir))
195 (loc-list (car loc-seen))
196 (seen-list (cdr loc-seen))
197 overview number-alist mark-alist entity
198 i percent num location pair)
199 (setq num (length numlist))
201 (message "Creating msgdb...")
204 (elmo-maildir-msgdb-create-entity
205 dir (car numlist) loc-alist))
209 (elmo-msgdb-append-element
212 (elmo-msgdb-number-add number-alist
213 (elmo-msgdb-overview-entity-get-number
215 (elmo-msgdb-overview-entity-get-id
217 (setq location (cdr (assq (car numlist) loc-alist)))
218 (unless (member location seen-list)
220 (elmo-msgdb-mark-append
222 (elmo-msgdb-overview-entity-get-number
224 (or (elmo-msgdb-global-mark-get
225 (elmo-msgdb-overview-entity-get-id
228 (when (> num elmo-display-progress-threshold)
230 (setq percent (/ (* i 100) num))
231 (elmo-display-progress
232 'elmo-maildir-msgdb-create "Creating msgdb..."
234 (setq numlist (cdr numlist)))
235 (message "Creating msgdb...done")
236 (elmo-msgdb-sort-by-date
237 (list overview number-alist mark-alist loc-alist)))))
239 (defalias 'elmo-maildir-msgdb-create-as-numlist 'elmo-maildir-msgdb-create)
241 (defun elmo-maildir-list-folders (spec &optional hierarchy)
242 (let ((elmo-localdir-folder-path elmo-maildir-folder-path)
243 (elmo-localdir-list-folders-spec-string ".")
244 (elmo-localdir-list-folders-filter-regexp
245 "^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$")
246 elmo-have-link-count folders)
247 (setq folders (elmo-localdir-list-folders spec hierarchy))
248 (if (eq (length (nth 1 spec)) 0) ; top
249 (setq folders (append
250 (list (concat elmo-localdir-list-folders-spec-string
254 (function (lambda (folder)
255 (not (or (listp folder) (elmo-folder-exists-p folder)))))
259 ((>= emacs-major-version 19)
260 (defun elmo-maildir-make-unique-string ()
261 "This function generates a string that can be used as a unique
262 file name for maildir directories."
263 (let ((cur-time (current-time)))
264 (format "%.0f.%d_%d.%s"
266 (float 65536)) (cadr cur-time))
268 (incf elmo-maildir-sequence-number-internal)
270 ((eq emacs-major-version 18)
271 ;; A fake function for v18
272 (defun elmo-maildir-make-unique-string ()
273 "This function generates a string that can be used as a unique
274 file name for maildir directories."
275 (unless (fboundp 'float-to-string)
276 (load-library "float"))
277 (let ((time (current-time)))
281 (f+ (f* (f (car time))
286 (% (abs (random t)) 10000); dummy pid
289 (defun elmo-maildir-temporal-filename (basedir)
290 (let ((filename (expand-file-name
291 (concat "tmp/" (elmo-maildir-make-unique-string))
293 (unless (file-exists-p (file-name-directory filename))
294 (make-directory (file-name-directory filename)))
295 (while (file-exists-p filename)
296 ;; (sleep-for 2) ; I don't want to wait.
299 (concat "tmp/" (elmo-maildir-make-unique-string))
303 (defun elmo-maildir-append-msg (spec string &optional msg no-see)
304 (let ((basedir (elmo-maildir-get-folder-directory spec))
308 (setq filename (elmo-maildir-temporal-filename basedir))
310 (as-binary-output-file
311 (write-region (point-min) (point-max) filename nil 'no-msg))
312 ;; add link from new.
313 (elmo-add-name-to-file
316 (concat "new/" (file-name-nondirectory filename))
319 ;; If an error occured, return nil.
322 (defun elmo-maildir-delete-msg (spec number loc-alist)
323 (let ((dir (elmo-maildir-get-folder-directory spec))
325 (setq file (elmo-maildir-number-to-filename dir number loc-alist))
326 (if (and (file-writable-p file)
327 (not (file-directory-p file)))
328 (progn (delete-file file)
331 (defun elmo-maildir-read-msg (spec number outbuf &optional msgdb)
333 (let* ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
334 (elmo-msgdb-location-load (elmo-msgdb-expand-path
336 (dir (elmo-maildir-get-folder-directory spec))
337 (file (elmo-maildir-number-to-filename dir number loc-alist)))
340 (when (file-exists-p file)
341 (as-binary-input-file (insert-file-contents file))
342 (elmo-delete-cr-get-content-type)))))
344 (defun elmo-maildir-delete-msgs (spec msgs &optional msgdb)
345 (let ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
346 (elmo-msgdb-location-load (elmo-msgdb-expand-path
348 (mapcar '(lambda (msg) (elmo-maildir-delete-msg spec msg
352 (defsubst elmo-maildir-list-folder-subr (spec &optional nonsort)
353 (let* ((dir (elmo-maildir-get-folder-directory spec))
354 (flist (elmo-list-folder-by-location
356 (car (elmo-maildir-list-location dir))))
357 (killed (and elmo-use-killed-list
358 (elmo-msgdb-killed-list-load
359 (elmo-msgdb-expand-path spec))))
360 (news (car (elmo-maildir-list-location dir "new")))
363 (cons (+ (or (elmo-max-of-list flist) 0) (length news))
367 (elmo-msgdb-killed-list-length killed))
369 (setq numbers (sort flist '<))
370 (elmo-living-messages numbers killed))))
372 (defun elmo-maildir-list-folder (spec)
373 (elmo-maildir-update-current spec)
374 (elmo-maildir-list-folder-subr spec))
376 (defun elmo-maildir-max-of-folder (spec)
377 (elmo-maildir-list-folder-subr spec t))
379 (defalias 'elmo-maildir-check-validity 'elmo-localdir-check-validity)
381 (defalias 'elmo-maildir-sync-validity 'elmo-localdir-sync-validity)
383 (defun elmo-maildir-folder-exists-p (spec)
384 (let ((basedir (elmo-maildir-get-folder-directory spec)))
385 (and (file-directory-p (expand-file-name "new" basedir))
386 (file-directory-p (expand-file-name "cur" basedir))
387 (file-directory-p (expand-file-name "tmp" basedir)))))
389 (defun elmo-maildir-folder-creatable-p (spec)
392 (defun elmo-maildir-create-folder (spec)
393 (let ((basedir (elmo-maildir-get-folder-directory spec)))
396 (mapcar (function (lambda (dir)
397 (setq dir (expand-file-name dir basedir))
398 (or (file-directory-p dir)
400 (elmo-make-directory dir)
401 (set-file-modes dir 448)))))
402 '("." "new" "cur" "tmp"))
406 (defun elmo-maildir-delete-folder (spec)
407 (let ((basedir (elmo-maildir-get-folder-directory spec)))
409 (let ((tmp-files (directory-files
410 (expand-file-name "tmp" basedir)
412 ;; Delete files in tmp.
413 (and tmp-files (mapcar 'delete-file tmp-files))
417 (setq dir (expand-file-name dir basedir))
418 (if (not (file-directory-p dir))
420 (elmo-delete-directory dir t))))
421 '("new" "cur" "tmp" "."))
425 (defun elmo-maildir-search (spec condition &optional from-msgs msgdb)
427 (let* ((msgs (or from-msgs (elmo-maildir-list-folder spec)))
428 (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
429 (elmo-msgdb-location-load (elmo-msgdb-expand-path
431 (dir (elmo-maildir-get-folder-directory spec))
433 case-fold-search ret-val
437 (setq number-list msgs)
439 (setq msg-num (car msgs))
440 (if (elmo-file-field-condition-match
441 (elmo-maildir-number-to-filename
442 dir (car msgs) loc-alist)
443 condition (car msgs) number-list)
444 (setq ret-val (append ret-val (list msg-num))))
446 (setq percent (/ (* i 100) num))
447 (elmo-display-progress
448 'elmo-maildir-search "Searching..."
450 (setq msgs (cdr msgs)))
453 ;;; (maildir) -> maildir
454 (defun elmo-maildir-copy-msgs (dst-spec msgs src-spec
455 &optional loc-alist same-number)
459 (elmo-maildir-get-msg-filename src-spec (car msgs) loc-alist))
465 (file-name-nondirectory srcfile)
466 (concat (elmo-maildir-get-folder-directory dst-spec) "/cur")))
467 (setq msgs (cdr msgs))))
470 (defun elmo-maildir-use-cache-p (spec number)
473 (defun elmo-maildir-local-file-p (spec number)
476 (defun elmo-maildir-get-msg-filename (spec number &optional loc-alist)
477 (elmo-maildir-number-to-filename
478 (elmo-maildir-get-folder-directory spec)
479 number (or loc-alist (elmo-msgdb-location-load
480 (elmo-msgdb-expand-path
483 (defun elmo-maildir-pack-number (spec msgdb arg)
484 (let ((old-number-alist (elmo-msgdb-get-number-alist msgdb))
485 (old-overview (elmo-msgdb-get-overview msgdb))
486 (old-mark-alist (elmo-msgdb-get-mark-alist msgdb))
487 (old-location (elmo-msgdb-get-location msgdb))
488 old-number overview number-alist mark-alist location
490 (setq overview old-overview)
493 (elmo-msgdb-overview-entity-get-number (car old-overview)))
494 (elmo-msgdb-overview-entity-set-number (car old-overview) number)
496 (cons (cons number (cdr (assq old-number old-number-alist)))
498 (when (setq mark (cadr (assq old-number old-mark-alist)))
500 (elmo-msgdb-mark-append
501 mark-alist number mark)))
503 (cons (cons number (cdr (assq old-number old-location)))
505 (setq number (1+ number))
506 (setq old-overview (cdr old-overview)))
507 ;; XXX Should consider when folder is not persistent.
508 (elmo-msgdb-location-save (elmo-msgdb-expand-path spec) location)
510 (nreverse number-alist)
511 (nreverse mark-alist)
513 (elmo-msgdb-make-overview-hashtb overview))))
515 (defalias 'elmo-maildir-sync-number-alist
516 'elmo-generic-sync-number-alist)
517 (defalias 'elmo-maildir-list-folder-unread
518 'elmo-generic-list-folder-unread)
519 (defalias 'elmo-maildir-list-folder-important
520 'elmo-generic-list-folder-important)
521 (defalias 'elmo-maildir-commit 'elmo-generic-commit)
522 (defalias 'elmo-maildir-folder-diff 'elmo-generic-folder-diff)
525 (product-provide (provide 'elmo-maildir) (require 'elmo-version))
527 ;;; elmo-maildir.el ends here