-;;; elmo-maildir.el -- Maildir interface for ELMO.
+;;; elmo-maildir.el --- Maildir interface for ELMO.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(eval-when-compile (require 'cl))
(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
(luna-define-method elmo-folder-expand-msgdb-path ((folder
elmo-maildir-folder))
- (expand-file-name
- (elmo-replace-string-as-filename
+ (expand-file-name
+ (elmo-replace-string-as-filename
(elmo-maildir-folder-directory-internal folder))
(expand-file-name
"maildir"
- elmo-msgdb-dir)))
+ elmo-msgdb-directory)))
(defun elmo-maildir-message-file-name (folder location)
"Get a file name of the message from FOLDER which corresponded to
(elmo-maildir-folder-flagged-locations-internal folder))
(luna-define-method elmo-folder-msgdb-create
- ((folder elmo-maildir-folder)
- numbers new-mark already-mark seen-mark important-mark seen-list)
+ ((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))
(len (length numbers))
entity)))
(cond
((member location unread-list)
- (setq mark new-mark)) ; unread!
+ (setq mark elmo-msgdb-new-mark)) ; unread!
((member location flagged-list)
- (setq mark important-mark)))
+ (setq mark elmo-msgdb-important-mark)))
(if (setq mark (or (elmo-msgdb-global-mark-get
(elmo-msgdb-overview-entity-get-id
entity))
(while news
(rename-file
(expand-file-name (car news) (expand-file-name "new" maildir))
- (expand-file-name (concat (car news) ":2,")
+ (expand-file-name (concat
+ (car news)
+ (unless (string-match ":2,[A-Z]*$" (car news))
+ ":2,"))
(expand-file-name "cur" maildir)))
(setq news (cdr news)))))
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)
filename))
(luna-define-method elmo-folder-append-buffer ((folder elmo-maildir-folder)
- unread &optional number)
+ &optional status number)
(let ((basedir (elmo-maildir-folder-directory-internal folder))
(src-buf (current-buffer))
dst-buf filename)
numbers
&optional
start-number)
- (let ((temp-dir (elmo-folder-make-temp-dir folder))
+ (let ((temp-dir (elmo-folder-make-temporary-directory folder))
(cur-number (if start-number 0)))
(dolist (number numbers)
(elmo-copy-file
(luna-define-method elmo-folder-append-messages :around
((folder elmo-maildir-folder)
- src-folder numbers unread-marks &optional same-number)
+ src-folder numbers &optional same-number)
(if (elmo-folder-message-file-p src-folder)
(let ((dir (elmo-maildir-folder-directory-internal folder))
(succeeds numbers)
filename)
- (setq filename (elmo-maildir-temporal-filename dir))
(dolist (number numbers)
+ (setq filename (elmo-maildir-temporal-filename dir))
(elmo-copy-file
(elmo-message-file-name src-folder number)
filename)
filename
(expand-file-name
(concat "new/" (file-name-nondirectory filename))
- dir)))
+ dir))
+ (elmo-progress-notify 'elmo-folder-move-messages))
succeeds)
(luna-call-next-method)))
(error))))
(luna-define-method elmo-folder-delete ((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.
- (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)))
- t)
- (error nil))))
-
-(luna-define-method elmo-folder-search ((folder elmo-maildir-folder)
- condition &optional numbers)
- (save-excursion
- (let* ((msgs (or numbers (elmo-folder-list-messages folder)))
- (i 0)
- case-fold-search matches
- percent num
- (len (length msgs))
- number-list msg-num)
- (setq number-list msgs)
- (dolist (number numbers)
- (if (elmo-file-field-condition-match
- (elmo-message-file-name folder number)
- condition number number-list)
- (setq matches (cons number matches)))
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-maildir-search "Searching..."
- (/ (* i 100) len)))
- (nreverse matches))))
+ (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))
projects / elisp / wanderlust.git / blobdiff