-;;; elmo-maildir.el -- Maildir interface for ELMO.
+;;; elmo-maildir.el --- Maildir interface for ELMO.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; Keywords: mail, net news
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(eval-when-compile (require 'cl))
-(require 'elmo-util)
-(require 'elmo-localdir)
-
-(defvar elmo-maildir-sequence-number-internal 0
- "Sequence number for the pid part of unique filename.
-This variable should not be used in elsewhere.")
-
-(defsubst elmo-maildir-get-folder-directory (spec)
- (if (file-name-absolute-p (nth 1 spec))
- (nth 1 spec) ; already full path.
- (expand-file-name (nth 1 spec)
- elmo-maildir-folder-path)))
-
-(defun elmo-maildir-number-to-filename (dir number loc-alist)
- (let ((location (cdr (assq number loc-alist))))
- (and location (elmo-maildir-get-filename location dir))))
-(defun elmo-maildir-get-filename (location dir)
- "Get a filename that is corresponded to LOCATION in DIR."
+(require 'elmo-util)
+(require 'elmo)
+(require 'elmo-map)
+
+(defcustom elmo-maildir-folder-path "~/Maildir"
+ "*Maildir folder path."
+ :type 'directory
+ :group 'elmo)
+
+;;; ELMO Maildir folder
+(eval-and-compile
+ (luna-define-class elmo-maildir-folder
+ (elmo-map-folder)
+ (directory unread-locations
+ flagged-locations
+ answered-locations))
+ (luna-define-internal-accessors 'elmo-maildir-folder))
+
+(luna-define-method elmo-folder-initialize ((folder
+ elmo-maildir-folder)
+ name)
+ (if (file-name-absolute-p name)
+ (elmo-maildir-folder-set-directory-internal
+ folder
+ (expand-file-name name))
+ (elmo-maildir-folder-set-directory-internal
+ folder
+ (expand-file-name
+ name
+ elmo-maildir-folder-path)))
+ folder)
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-maildir-folder))
(expand-file-name
- (let ((file (file-name-completion (symbol-name location)
- (expand-file-name "cur" dir))))
- (if (eq file t) location file))
- (expand-file-name "cur" dir)))
+ (elmo-replace-string-as-filename
+ (elmo-maildir-folder-directory-internal folder))
+ (expand-file-name
+ "maildir"
+ elmo-msgdb-directory)))
+
+(defun elmo-maildir-message-file-name (folder location)
+ "Get a file name of the message from FOLDER which corresponded to
+LOCATION."
+ (let ((file (file-name-completion
+ location
+ (expand-file-name
+ "cur"
+ (elmo-maildir-folder-directory-internal folder)))))
+ (if file
+ (expand-file-name
+ (if (eq file t) location file)
+ (expand-file-name
+ "cur"
+ (elmo-maildir-folder-directory-internal folder))))))
(defsubst elmo-maildir-list-location (dir &optional child-dir)
(let* ((cur-dir (expand-file-name (or child-dir "cur") dir))
(cur (directory-files cur-dir
nil "^[^.].*$" t))
- seen-list seen sym list)
- (setq list
- (mapcar
+ unread-locations flagged-locations answered-locations
+ seen flagged answered sym locations)
+ (setq locations
+ (mapcar
(lambda (x)
(if (string-match "^\\([^:]+\\):\\([^:]+\\)$" x)
(progn
- (setq seen nil)
+ (setq seen nil answered nil flagged nil)
(save-match-data
- (if (string-match
- "S"
- (elmo-match-string 2 x))
- (setq seen t)))
- (setq sym (intern (elmo-match-string 1 x)))
- (if seen
- (setq seen-list (cons sym seen-list)))
+ (cond
+ ((string-match "F" (elmo-match-string 2 x))
+ (setq flagged t))
+ ((string-match "R" (elmo-match-string 2 x))
+ (setq answered t))
+ ((string-match "S" (elmo-match-string 2 x))
+ (setq seen t))))
+ (setq sym (elmo-match-string 1 x))
+ (cond
+ (flagged (setq flagged-locations
+ (cons sym flagged-locations)))
+ (answered (setq answered-locations
+ (cons sym answered-locations)))
+ (seen)
+ (t
+ (setq unread-locations (cons sym unread-locations))))
sym)
- (intern x)))
+ x))
cur))
- (cons list seen-list)))
-
-(defun elmo-maildir-msgdb-create-entity (dir number loc-alist)
- (elmo-localdir-msgdb-create-overview-entity-from-file
- number
- (elmo-maildir-number-to-filename dir number loc-alist)))
+ (list locations unread-locations flagged-locations answered-locations)))
+
+(luna-define-method elmo-map-folder-list-message-locations
+ ((folder elmo-maildir-folder))
+ (elmo-maildir-update-current folder)
+ (let ((locs (elmo-maildir-list-location
+ (elmo-maildir-folder-directory-internal folder))))
+ ;; 0: locations, 1: unread-locs, 2: flagged-locs 3: answered-locs
+ (elmo-maildir-folder-set-unread-locations-internal folder (nth 1 locs))
+ (elmo-maildir-folder-set-flagged-locations-internal folder (nth 2 locs))
+ (elmo-maildir-folder-set-answered-locations-internal folder (nth 3 locs))
+ (nth 0 locs)))
+
+(luna-define-method elmo-map-folder-list-unreads
+ ((folder elmo-maildir-folder))
+ (elmo-maildir-folder-unread-locations-internal folder))
+
+(luna-define-method elmo-map-folder-list-importants
+ ((folder elmo-maildir-folder))
+ (elmo-maildir-folder-flagged-locations-internal folder))
+
+(luna-define-method elmo-map-folder-list-answereds
+ ((folder elmo-maildir-folder))
+ (elmo-maildir-folder-answered-locations-internal folder))
+
+(luna-define-method elmo-folder-msgdb-create
+ ((folder elmo-maildir-folder) numbers flag-table)
+ (let* ((unread-list (elmo-maildir-folder-unread-locations-internal folder))
+ (flagged-list (elmo-maildir-folder-flagged-locations-internal folder))
+ (answered-list (elmo-maildir-folder-answered-locations-internal
+ folder))
+ (len (length numbers))
+ (i 0)
+ overview number-alist mark-alist entity message-id flag
+ file location pair mark cache-status file-flag)
+ (message "Creating msgdb...")
+ (dolist (number numbers)
+ (setq location (elmo-map-message-location folder number))
+ (setq entity
+ (elmo-msgdb-create-overview-entity-from-file
+ number
+ (setq file
+ (elmo-maildir-message-file-name folder location))))
+ (when entity
+ (setq overview
+ (elmo-msgdb-append-element overview entity)
+ number-alist
+ (elmo-msgdb-number-add number-alist
+ (elmo-message-entity-number entity)
+ (setq message-id
+ (elmo-message-entity-field
+ entity 'message-id)))
+ ;; Precede flag-table to file-info.
+ flag (elmo-flag-table-get flag-table message-id)
+ file-flag nil
+ mark nil)
+ (setq cache-status
+ (elmo-file-cache-status (elmo-file-cache-get message-id)))
+
+ ;; Already flagged on filename (precede it to flag-table).
+ (cond
+ ((member location flagged-list)
+ (setq file-flag 'important
+ mark elmo-msgdb-important-mark))
+ ((member location answered-list)
+ (setq file-flag 'answered
+ mark (elmo-msgdb-mark 'answered cache-status)))
+ ((member location unread-list)
+ (setq file-flag 'unread
+ mark (elmo-msgdb-mark 'unread cache-status)))
+ (t (setq file-flag 'read)))
+
+ ;; Set mark according to flag-table if file status is unread or read.
+ (when (or (eq file-flag 'read)
+ (eq file-flag 'unread))
+ ;;
+ (unless (eq 'read flag)
+ (setq mark (elmo-msgdb-mark flag cache-status 'new)))
+ ;; Update filename's info portion according to the flag-table.
+ (cond
+ ((and (or (eq flag 'important)
+ (setq mark (elmo-msgdb-global-mark-get
+ (elmo-message-entity-field
+ entity 'message-id))))
+ (not (eq file-flag 'important)))
+ (elmo-maildir-set-mark file ?F)
+ ;; Delete from unread location list.
+ (elmo-maildir-folder-set-unread-locations-internal
+ folder
+ (delete location
+ (elmo-maildir-folder-unread-locations-internal
+ folder)))
+ ;; Append to flagged location list.
+ (elmo-maildir-folder-set-flagged-locations-internal
+ folder
+ (cons location
+ (elmo-maildir-folder-flagged-locations-internal
+ folder))))
+ ((and (eq flag 'answered)
+ (not (eq file-flag 'answered)))
+ (elmo-maildir-set-mark file ?R)
+ ;; Delete from unread locations.
+ (elmo-maildir-folder-set-unread-locations-internal
+ folder
+ (delete location
+ (elmo-maildir-folder-unread-locations-internal folder)))
+ ;; Append to answered location list.
+ (elmo-maildir-folder-set-answered-locations-internal
+ folder
+ (cons location
+ (elmo-maildir-folder-answered-locations-internal folder))))
+ ((and (eq flag 'read)
+ (not (eq file-flag 'read)))
+ (elmo-maildir-set-mark file ?S)
+ ;; Delete from unread locations.
+ (elmo-maildir-folder-set-unread-locations-internal
+ folder
+ (delete location
+ (elmo-maildir-folder-unread-locations-internal
+ folder))))))
+ (if mark
+ (setq mark-alist
+ (elmo-msgdb-mark-append
+ mark-alist
+ (elmo-msgdb-overview-entity-get-number
+ entity)
+ mark)))
+ (when (> len elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (elmo-display-progress
+ 'elmo-maildir-msgdb-create "Creating msgdb..."
+ (/ (* i 100) len)))))
+ (message "Creating msgdb...done")
+ (elmo-msgdb-sort-by-date
+ (list overview number-alist mark-alist))))
(defun elmo-maildir-cleanup-temporal (dir)
;; Delete files in the tmp dir which are not accessed
(let ((cur-time (current-time))
(count 0)
last-accessed)
- (mapcar (function
+ (mapcar (function
(lambda (file)
(setq last-accessed (nth 4 (file-attributes file)))
(when (or (> (- (car cur-time)(car last-accessed)) 1)
t ; full
"^[^.].*$" t))))
-(defun elmo-maildir-update-current (spec)
- "Move all new msgs to cur in the maildir"
- (let* ((maildir (elmo-maildir-get-folder-directory spec))
+(defun elmo-maildir-update-current (folder)
+ "Move all new msgs to cur in the maildir."
+ (let* ((maildir (elmo-maildir-folder-directory-internal folder))
(news (directory-files (expand-file-name "new"
maildir)
nil
;; cleanup tmp directory.
(elmo-maildir-cleanup-temporal maildir)
;; move new msgs to cur directory.
- (mapcar (lambda (x)
- (rename-file
- (expand-file-name x (expand-file-name "new" maildir))
- (expand-file-name (concat x ":2,")
- (expand-file-name "cur" maildir))))
- news)))
+ (while news
+ (rename-file
+ (expand-file-name (car news) (expand-file-name "new" maildir))
+ (expand-file-name (concat
+ (car news)
+ (unless (string-match ":2,[A-Z]*$" (car news))
+ ":2,"))
+ (expand-file-name "cur" maildir)))
+ (setq news (cdr news)))))
(defun elmo-maildir-set-mark (filename mark)
- "Mark the file in the maildir. MARK is a character."
- (if (string-match "^\\([^:]+:2,\\)\\(.*\\)$" filename)
- (let ((flaglist (string-to-char-list (elmo-match-string
+ "Mark the FILENAME file in the maildir. MARK is a character."
+ (if (string-match "^\\([^:]+:[12],\\)\\(.*\\)$" filename)
+ (let ((flaglist (string-to-char-list (elmo-match-string
2 filename))))
(unless (memq mark flaglist)
(setq flaglist (sort (cons mark flaglist) '<))
(rename-file filename
(concat (elmo-match-string 1 filename)
- (char-list-to-string flaglist)))))))
+ (char-list-to-string flaglist)))))
+ ;; Rescue no info file in maildir.
+ (rename-file filename
+ (concat filename ":2," (char-to-string mark))))
+ t)
(defun elmo-maildir-delete-mark (filename mark)
- "Mark the file in the maildir. MARK is a character."
+ "Mark the FILENAME file in the maildir. MARK is a character."
(if (string-match "^\\([^:]+:2,\\)\\(.*\\)$" filename)
- (let ((flaglist (string-to-char-list (elmo-match-string
+ (let ((flaglist (string-to-char-list (elmo-match-string
2 filename))))
(when (memq mark flaglist)
(setq flaglist (delq mark flaglist))
(if flaglist
(char-list-to-string flaglist))))))))
-(defsubst elmo-maildir-set-mark-msgs (spec mark msgs msgdb)
- (let ((dir (elmo-maildir-get-folder-directory spec))
- (locs (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path nil spec))))
- file)
- (while msgs
- (if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs))
- (elmo-maildir-set-mark file mark))
- (setq msgs (cdr msgs)))))
-
-(defsubst elmo-maildir-delete-mark-msgs (spec mark msgs msgdb)
- (let ((dir (elmo-maildir-get-folder-directory spec))
- (locs (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path nil spec))))
- file)
- (while msgs
- (if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs))
- (elmo-maildir-delete-mark file mark))
- (setq msgs (cdr msgs)))))
-
-(defun elmo-maildir-mark-as-important (spec msgs &optional msgdb)
- (elmo-maildir-set-mark-msgs spec ?F msgs msgdb))
+(defsubst elmo-maildir-set-mark-msgs (folder locs mark)
+ (dolist (loc locs)
+ (elmo-maildir-set-mark
+ (elmo-maildir-message-file-name folder loc)
+ mark))
+ t)
+
+(defsubst elmo-maildir-delete-mark-msgs (folder locs mark)
+ (dolist (loc locs)
+ (elmo-maildir-delete-mark
+ (elmo-maildir-message-file-name folder loc)
+ mark))
+ t)
+
+(luna-define-method elmo-map-folder-mark-as-important ((folder elmo-maildir-folder)
+ locs)
+ (elmo-maildir-set-mark-msgs folder locs ?F))
-(defun elmo-maildir-unmark-important (spec msgs &optional msgdb)
- (elmo-maildir-delete-mark-msgs spec ?F msgs msgdb))
-
-(defun elmo-maildir-mark-as-read (spec msgs &optional msgdb)
- (elmo-maildir-set-mark-msgs spec ?S msgs msgdb))
-
-(defun elmo-maildir-mark-as-unread (spec msgs &optional msgdb)
- (elmo-maildir-delete-mark-msgs spec ?S msgs msgdb))
-
-(defun elmo-maildir-msgdb-create (spec numlist new-mark
- already-mark seen-mark
- important-mark
- seen-list
- &optional msgdb)
- (when numlist
- (let* ((dir (elmo-maildir-get-folder-directory spec))
- (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- nil spec))))
- (loc-seen (elmo-maildir-list-location dir))
- (loc-list (car loc-seen))
- (seen-list (cdr loc-seen))
- overview number-alist mark-alist entity
- i percent num location pair)
- (setq num (length numlist))
- (setq i 0)
- (message "Creating msgdb...")
- (while numlist
- (setq entity
- (elmo-maildir-msgdb-create-entity
- dir (car numlist) loc-alist))
- (if (null entity)
- ()
- (setq overview
- (elmo-msgdb-append-element
- overview entity))
- (setq number-alist
- (elmo-msgdb-number-add number-alist
- (elmo-msgdb-overview-entity-get-number
- entity)
- (elmo-msgdb-overview-entity-get-id
- entity)))
- (setq location (cdr (assq (car numlist) loc-alist)))
- (unless (member location seen-list)
- (setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist
- (elmo-msgdb-overview-entity-get-number
- entity)
- (or (elmo-msgdb-global-mark-get
- (elmo-msgdb-overview-entity-get-id
- entity))
- new-mark)))))
- (setq i (1+ i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-maildir-msgdb-create "Creating msgdb..."
- percent)
- (setq numlist (cdr numlist)))
- (message "Creating msgdb...done.")
- (elmo-msgdb-sort-by-date
- (list overview number-alist mark-alist loc-alist)))))
-
-(defalias 'elmo-maildir-msgdb-create-as-numlist 'elmo-maildir-msgdb-create)
-
-(defun elmo-maildir-list-folders (spec &optional hierarchy)
- (let ((elmo-localdir-folder-path elmo-maildir-folder-path)
- (elmo-localdir-list-folders-spec-string ".")
- (elmo-localdir-list-folders-filter-regexp
+(luna-define-method elmo-map-folder-unmark-important ((folder elmo-maildir-folder)
+ locs)
+ (elmo-maildir-delete-mark-msgs folder locs ?F))
+
+(luna-define-method elmo-map-folder-mark-as-read ((folder elmo-maildir-folder)
+ locs)
+ (elmo-maildir-set-mark-msgs folder locs ?S))
+
+(luna-define-method elmo-map-folder-unmark-read ((folder elmo-maildir-folder)
+ locs)
+ (elmo-maildir-delete-mark-msgs folder locs ?S))
+
+(luna-define-method elmo-map-folder-mark-as-answered ((folder
+ elmo-maildir-folder)
+ locs)
+ (elmo-maildir-set-mark-msgs folder locs ?R))
+
+(luna-define-method elmo-map-folder-unmark-answered ((folder
+ elmo-maildir-folder)
+ locs)
+ (elmo-maildir-delete-mark-msgs folder locs ?R))
+
+(luna-define-method elmo-folder-list-subfolders
+ ((folder elmo-maildir-folder) &optional one-level)
+ (let ((prefix (concat (elmo-folder-name-internal folder)
+ (unless (string= (elmo-folder-prefix-internal folder)
+ (elmo-folder-name-internal folder))
+ elmo-path-sep)))
+ (elmo-list-subdirectories-ignore-regexp
"^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$")
- elmo-have-link-count folders)
- (setq folders (elmo-localdir-list-folders spec hierarchy))
- (if (eq (length (nth 1 spec)) 0) ; top
- (setq folders (append
- (list (concat elmo-localdir-list-folders-spec-string
- (nth 1 spec)))
- folders)))
- (elmo-delete-if
- (function (lambda (folder)
- (not (or (listp folder) (elmo-folder-exists-p folder)))))
- folders)))
-
-(static-cond
+ elmo-have-link-count)
+ (append
+ (list (elmo-folder-name-internal folder))
+ (elmo-mapcar-list-of-list
+ (function (lambda (x) (concat prefix x)))
+ (elmo-list-subdirectories
+ (elmo-maildir-folder-directory-internal folder)
+ ""
+ one-level)))))
+
+(defvar elmo-maildir-sequence-number-internal 0)
+
+(static-cond
((>= emacs-major-version 19)
(defun elmo-maildir-make-unique-string ()
"This function generates a string that can be used as a unique
-file name for maildir directories."
+file name for maildir directories."
(let ((cur-time (current-time)))
(format "%.0f.%d_%d.%s"
(+ (* (car cur-time)
(float-to-string
(f+ (f* (f (car time))
(f 65536))
- (f (cadr time))))
- 0 5)
+ (f (cadr time))))
+ 0 5)
(cadr time)
(% (abs (random t)) 10000); dummy pid
(system-name))))))
(defun elmo-maildir-temporal-filename (basedir)
- (let ((filename (expand-file-name
+ (let ((filename (expand-file-name
(concat "tmp/" (elmo-maildir-make-unique-string))
basedir)))
(unless (file-exists-p (file-name-directory filename))
(make-directory (file-name-directory filename)))
(while (file-exists-p filename)
- ;; (sleep-for 2) ; I don't want to wait.
- (setq filename
- (expand-file-name
+;;; I don't want to wait.
+;;; (sleep-for 2)
+ (setq filename
+ (expand-file-name
(concat "tmp/" (elmo-maildir-make-unique-string))
basedir)))
filename))
-(defun elmo-maildir-append-msg (spec string &optional msg no-see)
- (let ((basedir (elmo-maildir-get-folder-directory spec))
- filename)
+(luna-define-method elmo-folder-append-buffer ((folder elmo-maildir-folder)
+ &optional status number)
+ (let ((basedir (elmo-maildir-folder-directory-internal folder))
+ (src-buf (current-buffer))
+ dst-buf filename)
(condition-case nil
(with-temp-buffer
(setq filename (elmo-maildir-temporal-filename basedir))
- (insert string)
+ (setq dst-buf (current-buffer))
+ (with-current-buffer src-buf
+ (copy-to-buffer dst-buf (point-min) (point-max)))
(as-binary-output-file
(write-region (point-min) (point-max) filename nil 'no-msg))
;; add link from new.
(elmo-add-name-to-file
filename
- (expand-file-name
+ (expand-file-name
(concat "new/" (file-name-nondirectory filename))
basedir))
t)
;; If an error occured, return nil.
(error))))
-(defun elmo-maildir-delete-msg (spec number loc-alist)
- (let ((dir (elmo-maildir-get-folder-directory spec))
- file)
- (setq file (elmo-maildir-number-to-filename dir number loc-alist))
- (if (and (file-writable-p file)
- (not (file-directory-p file)))
- (progn (delete-file file)
- t))))
-
-(defun elmo-maildir-read-msg (spec number outbuf &optional msgdb)
- (save-excursion
- (let* ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- nil spec))))
- (dir (elmo-maildir-get-folder-directory spec))
- (file (elmo-maildir-number-to-filename dir number loc-alist)))
- (set-buffer outbuf)
- (erase-buffer)
- (when (file-exists-p file)
- (as-binary-input-file (insert-file-contents file))
- (elmo-delete-cr-get-content-type)))))
-
-(defun elmo-maildir-delete-msgs (spec msgs &optional msgdb)
- (let ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- nil spec)))))
- (mapcar '(lambda (msg) (elmo-maildir-delete-msg spec msg
- loc-alist))
- msgs)))
-
-(defsubst elmo-maildir-list-folder-subr (spec &optional nonsort)
- (let* ((dir (elmo-maildir-get-folder-directory spec))
- (flist (elmo-list-folder-by-location
- spec
- (car (elmo-maildir-list-location dir))))
- (news (car (elmo-maildir-list-location dir "new"))))
- (if nonsort
- (cons (+ (or (elmo-max-of-list flist) 0) (length news))
- (+ (length flist) (length news)))
- (sort flist '<))))
-
-(defun elmo-maildir-list-folder (spec)
- (elmo-maildir-update-current spec)
- (elmo-maildir-list-folder-subr spec))
-
-(defun elmo-maildir-max-of-folder (spec)
- (elmo-maildir-list-folder-subr spec t))
-
-(defalias 'elmo-maildir-check-validity 'elmo-localdir-check-validity)
-
-(defalias 'elmo-maildir-sync-validity 'elmo-localdir-sync-validity)
-
-(defun elmo-maildir-folder-exists-p (spec)
- (let ((basedir (elmo-maildir-get-folder-directory spec)))
+(luna-define-method elmo-folder-message-file-p ((folder elmo-maildir-folder))
+ t)
+
+(luna-define-method elmo-message-file-name ((folder elmo-maildir-folder)
+ number)
+ (elmo-maildir-message-file-name
+ folder
+ (elmo-map-message-location folder number)))
+
+(luna-define-method elmo-folder-message-make-temp-file-p
+ ((folder elmo-maildir-folder))
+ t)
+
+(luna-define-method elmo-folder-message-make-temp-files ((folder
+ elmo-maildir-folder)
+ numbers
+ &optional
+ start-number)
+ (let ((temp-dir (elmo-folder-make-temporary-directory folder))
+ (cur-number (if start-number 0)))
+ (dolist (number numbers)
+ (elmo-copy-file
+ (elmo-message-file-name folder number)
+ (expand-file-name
+ (int-to-string (if start-number (incf cur-number) number))
+ temp-dir)))
+ temp-dir))
+
+(luna-define-method elmo-folder-append-messages :around
+ ((folder elmo-maildir-folder)
+ src-folder numbers &optional same-number)
+ (if (elmo-folder-message-file-p src-folder)
+ (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
+ (dir (elmo-maildir-folder-directory-internal folder))
+ (table (elmo-flag-table-load (elmo-folder-msgdb-path folder)))
+ (succeeds numbers)
+ filename mark flag id)
+ (dolist (number numbers)
+ (setq mark (and src-msgdb-exists
+ (elmo-message-mark src-folder (car numbers)))
+ flag (cond
+ ((null mark) 'read)
+ ((member mark (elmo-msgdb-answered-marks))
+ 'answered)
+ ((not (member mark (elmo-msgdb-unread-marks)))
+ 'read))
+ filename (elmo-maildir-temporal-filename dir))
+ (elmo-copy-file
+ (elmo-message-file-name src-folder number)
+ filename)
+ (elmo-add-name-to-file
+ filename
+ (expand-file-name
+ (concat "new/" (file-name-nondirectory filename))
+ dir))
+ ;; src folder's msgdb is loaded.
+ (when (setq id (and src-msgdb-exists
+ (elmo-message-field src-folder (car numbers)
+ 'message-id)))
+ (elmo-flag-table-set table id flag))
+ (elmo-progress-notify 'elmo-folder-move-messages))
+ (when (elmo-folder-persistent-p folder)
+ (elmo-flag-table-save (elmo-folder-msgdb-path folder) table))
+ succeeds)
+ (luna-call-next-method)))
+
+(luna-define-method elmo-map-folder-delete-messages
+ ((folder elmo-maildir-folder) locations)
+ (let (file)
+ (dolist (location locations)
+ (setq file (elmo-maildir-message-file-name folder location))
+ (if (and file
+ (file-writable-p file)
+ (not (file-directory-p file)))
+ (delete-file file)))))
+
+(luna-define-method elmo-map-message-fetch ((folder elmo-maildir-folder)
+ location strategy
+ &optional section unseen)
+ (let ((file (elmo-maildir-message-file-name folder location)))
+ (when (file-exists-p file)
+ (insert-file-contents-as-binary file))))
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-maildir-folder))
+ (let ((basedir (elmo-maildir-folder-directory-internal folder)))
(and (file-directory-p (expand-file-name "new" basedir))
(file-directory-p (expand-file-name "cur" basedir))
(file-directory-p (expand-file-name "tmp" basedir)))))
-(defun elmo-maildir-folder-creatable-p (spec)
+(luna-define-method elmo-folder-diff ((folder elmo-maildir-folder))
+ (let* ((dir (elmo-maildir-folder-directory-internal folder))
+ (new-len (length (car (elmo-maildir-list-location dir "new"))))
+ (cur-len (length (car (elmo-maildir-list-location dir "cur")))))
+ (cons new-len (+ new-len cur-len))))
+
+(luna-define-method elmo-folder-creatable-p ((folder elmo-maildir-folder))
t)
-(defun elmo-maildir-create-folder (spec)
- (let ((basedir (elmo-maildir-get-folder-directory spec)))
- (condition-case nil
- (progn
- (mapcar (function (lambda (dir)
- (setq dir (expand-file-name dir basedir))
- (or (file-directory-p dir)
- (progn
- (elmo-make-directory dir)
- (set-file-modes dir 448)))))
- '("." "new" "cur" "tmp"))
- t)
- (error))))
+(luna-define-method elmo-folder-writable-p ((folder elmo-maildir-folder))
+ t)
-(defun elmo-maildir-delete-folder (spec)
- (let ((basedir (elmo-maildir-get-folder-directory spec)))
+(luna-define-method elmo-folder-create ((folder elmo-maildir-folder))
+ (let ((basedir (elmo-maildir-folder-directory-internal folder)))
(condition-case nil
- (let ((tmp-files (directory-files
- (expand-file-name "tmp" basedir)
- t "[^.].*")))
- ;; Delete files in tmp.
- (and tmp-files (mapcar 'delete-file tmp-files))
- (mapcar
- (function
- (lambda (dir)
- (setq dir (expand-file-name dir basedir))
- (if (not (file-directory-p dir))
- (error)
- (elmo-delete-directory dir t))))
- '("new" "cur" "tmp" "."))
+ (progn
+ (dolist (dir '("." "new" "cur" "tmp"))
+ (setq dir (expand-file-name dir basedir))
+ (or (file-directory-p dir)
+ (progn
+ (elmo-make-directory dir)
+ (set-file-modes dir 448))))
t)
(error))))
-(defun elmo-maildir-search (spec condition &optional from-msgs msgdb)
- (save-excursion
- (let* ((msgs (or from-msgs (elmo-maildir-list-folder spec)))
- (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- nil spec))))
- (dir (elmo-maildir-get-folder-directory spec))
- (i 0)
- case-fold-search ret-val
- percent num
- (num (length msgs))
- msg-num)
- (while msgs
- (setq msg-num (car msgs))
- (if (elmo-file-field-condition-match
- (elmo-maildir-number-to-filename
- dir (car msgs) loc-alist)
- condition)
- (setq ret-val (append ret-val (list msg-num))))
- (setq i (1+ i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-maildir-search "Searching..."
- percent)
- (setq msgs (cdr msgs)))
- ret-val)))
-
-;;; (maildir) -> maildir
-(defun elmo-maildir-copy-msgs (dst-spec msgs src-spec
- &optional loc-alist same-number)
- (let (srcfile)
- (while msgs
- (setq srcfile
- (elmo-maildir-get-msg-filename src-spec (car msgs) loc-alist))
- (elmo-copy-file
- ;; src file
- srcfile
- ;; dst file
- (expand-file-name
- (file-name-nondirectory srcfile)
- (concat (elmo-maildir-get-folder-directory dst-spec) "/cur")))
- (setq msgs (cdr msgs))))
- t)
-
-(defun elmo-maildir-use-cache-p (spec number)
- nil)
-
-(defun elmo-maildir-local-file-p (spec number)
- t)
-
-(defun elmo-maildir-get-msg-filename (spec number &optional loc-alist)
- (elmo-maildir-number-to-filename
- (elmo-maildir-get-folder-directory spec)
- number (or loc-alist (elmo-msgdb-location-load
- (elmo-msgdb-expand-path
- nil spec)))))
-
-(defalias 'elmo-maildir-sync-number-alist
- 'elmo-generic-sync-number-alist)
-(defalias 'elmo-maildir-list-folder-unread
- 'elmo-generic-list-folder-unread)
-(defalias 'elmo-maildir-list-folder-important
- 'elmo-generic-list-folder-important)
-
-(provide 'elmo-maildir)
+(luna-define-method elmo-folder-delete ((folder elmo-maildir-folder))
+ (let ((msgs (and (elmo-folder-exists-p folder)
+ (elmo-folder-list-messages folder))))
+ (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
+ (if (> (length msgs) 0)
+ (format "%d msg(s) exists. " (length msgs))
+ "")
+ (elmo-folder-name-internal folder)))
+ (let ((basedir (elmo-maildir-folder-directory-internal folder)))
+ (condition-case nil
+ (let ((tmp-files (directory-files
+ (expand-file-name "tmp" basedir)
+ t "[^.].*")))
+ ;; Delete files in tmp.
+ (dolist (file tmp-files)
+ (delete-file file))
+ (dolist (dir '("new" "cur" "tmp" "."))
+ (setq dir (expand-file-name dir basedir))
+ (if (not (file-directory-p dir))
+ (error nil)
+ (elmo-delete-directory dir t))))
+ (error nil)))
+ (elmo-msgdb-delete-path folder)
+ t)))
+
+(luna-define-method elmo-folder-rename-internal ((folder elmo-maildir-folder)
+ new-folder)
+ (let* ((old (elmo-maildir-folder-directory-internal folder))
+ (new (elmo-maildir-folder-directory-internal new-folder))
+ (new-dir (directory-file-name (file-name-directory new))))
+ (unless (file-directory-p old)
+ (error "No such directory: %s" old))
+ (when (file-exists-p new)
+ (error "Already exists directory: %s" new))
+ (unless (file-directory-p new-dir)
+ (elmo-make-directory new-dir))
+ (rename-file old new)
+ t))
+
+(require 'product)
+(product-provide (provide 'elmo-maildir) (require 'elmo-version))
;;; elmo-maildir.el ends here
projects / elisp / wanderlust.git / blobdiff