X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-maildir.el;h=2c29937c3808a0215e55c5499fc4bb77b5fec843;hb=13ea09ab66b44b1a3b0971e1a24ce0da47a6ca0a;hp=f8db6dedaed18c947f57ee5eb7118b018ed57a8b;hpb=7187c95f7d174c7afe9dd237879848a235458a54;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-maildir.el b/elmo/elmo-maildir.el index f8db6de..2c29937 100644 --- a/elmo/elmo-maildir.el +++ b/elmo/elmo-maildir.el @@ -1,10 +1,9 @@ -;;; elmo-maildir.el -- Maildir interface for ELMO. +;;; elmo-maildir.el --- Maildir interface for ELMO. -;; Copyright 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news -;; Time-stamp: <00/04/24 10:19:24 teranisi> ;; This file is part of ELMO (Elisp Library for Message Orchestration). @@ -25,65 +24,231 @@ ;; ;;; 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) + +(defconst elmo-maildir-flag-specs '((important ?F) + (read ?S) + (unread ?S 'remove) + (answered ?R))) + +(defcustom elmo-maildir-separator + (if (memq system-type + '(windows-nt OS/2 emx ms-dos win32 w32 mswindows cygwin)) + ?\- ?:) + "Character separating the id section from the flags section. +According to the maildir specification, this should be a colon (?:), +but some file systems don't support colons in filenames." + :type 'character + :group 'elmo) + +(defmacro elmo-maildir-adjust-separator (string) + `(if (= elmo-maildir-separator ?:) + ,string + (elmo-replace-in-string + ,string ":" (char-to-string elmo-maildir-separator)))) + +;;; ELMO Maildir folder +(eval-and-compile + (luna-define-class elmo-maildir-folder + (elmo-map-folder elmo-file-tag) + (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 + (cur (mapcar (lambda (x) + (cons x (elmo-get-last-modification-time + (expand-file-name x cur-dir)))) + (directory-files cur-dir + nil "^[^.].*$" t))) + (regexp (elmo-maildir-adjust-separator "^\\(.+\\):[12],\\(.*\\)$")) + unread-locations flagged-locations answered-locations + sym locations flag-list x-time y-time) + (setq cur (sort cur + (lambda (x y) + (setq x-time (cdr x) + y-time (cdr y)) + (cond + ((< x-time y-time) + t) + ((eq x-time y-time) + (< (elmo-maildir-sequence-number (car x)) + (elmo-maildir-sequence-number (car y)))))))) + (setq locations + (mapcar (lambda (x) - (if (string-match "^\\([^:]+\\):\\([^:]+\\)$" x) - (progn - (setq seen 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))) - sym) - (intern x))) + (let ((name (car x))) + (if (string-match regexp name) + (progn + (setq sym (elmo-match-string 1 name) + flag-list (string-to-char-list + (elmo-match-string 2 name))) + (when (memq ?F flag-list) + (setq flagged-locations + (cons sym flagged-locations))) + (when (memq ?R flag-list) + (setq answered-locations + (cons sym answered-locations))) + (unless (memq ?S flag-list) + (setq unread-locations + (cons sym unread-locations))) + sym) + name))) 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-flagged ((folder elmo-maildir-folder) + flag) + (case flag + (unread + (elmo-maildir-folder-unread-locations-internal folder)) + (important + (elmo-maildir-folder-flagged-locations-internal folder)) + (answered + (elmo-maildir-folder-answered-locations-internal folder)) + (otherwise + t))) + +(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)) + (new-msgdb (elmo-make-msgdb)) + entity message-id flags location) + (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers)) + "Creating msgdb" + (dolist (number numbers) + (setq location (elmo-map-message-location folder number)) + (setq entity + (elmo-msgdb-create-message-entity-from-file + (elmo-msgdb-message-entity-handler new-msgdb) + number + (elmo-maildir-message-file-name folder location))) + (when entity + (setq message-id (elmo-message-entity-field entity 'message-id) + ;; Precede flag-table to file-info. + flags (copy-sequence + (elmo-flag-table-get flag-table message-id))) + + ;; Already flagged on filename (precede it to flag-table). + (when (member location flagged-list) + (or (memq 'important flags) + (setq flags (cons 'important flags)))) + (when (member location answered-list) + (or (memq 'answered flags) + (setq flags (cons 'answered flags)))) + (unless (member location unread-list) + (and (memq 'unread flags) + (setq flags (delq 'unread flags)))) + + ;; Update filename's info portion according to the flag-table. + (when (and (memq 'important flags) + (not (member location flagged-list))) + (elmo-maildir-set-mark + (elmo-maildir-message-file-name folder location) + ?F) + ;; Append to flagged location list. + (elmo-maildir-folder-set-flagged-locations-internal + folder + (cons location + (elmo-maildir-folder-flagged-locations-internal + folder))) + (setq flags (delq 'unread flags))) + (when (and (memq 'answered flags) + (not (member location answered-list))) + (elmo-maildir-set-mark + (elmo-maildir-message-file-name folder location) + ?R) + ;; Append to answered location list. + (elmo-maildir-folder-set-answered-locations-internal + folder + (cons location + (elmo-maildir-folder-answered-locations-internal folder))) + (setq flags (delq 'unread flags))) + (when (and (not (memq 'unread flags)) + (member location unread-list)) + (elmo-maildir-set-mark + (elmo-maildir-message-file-name folder location) + ?S) + ;; Delete from unread locations. + (elmo-maildir-folder-set-unread-locations-internal + folder + (delete location + (elmo-maildir-folder-unread-locations-internal + folder)))) + (unless (memq 'unread flags) + (setq flags (delq 'new flags))) + (elmo-global-flags-set flags folder number message-id) + (elmo-msgdb-append-entity new-msgdb entity flags)) + (elmo-progress-notify 'elmo-folder-msgdb-create))) + new-msgdb)) (defun elmo-maildir-cleanup-temporal (dir) ;; Delete files in the tmp dir which are not accessed @@ -91,23 +256,23 @@ This variable should not be used in elsewhere.") (let ((cur-time (current-time)) (count 0) last-accessed) - (mapcar (function - (lambda (file) - (setq last-accessed (nth 4 (file-attributes file))) - (when (or (> (- (car cur-time)(car last-accessed)) 1) - (and (eq (- (car cur-time)(car last-accessed)) 1) - (> (- (cadr cur-time)(cadr last-accessed)) - 64064))) ; 36 hours. - (message "Maildir: %d tmp file(s) are cleared." - (setq count (1+ count))) - (delete-file file)))) - (directory-files (expand-file-name "tmp" dir) - 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)) + (mapcar + (lambda (file) + (setq last-accessed (nth 4 (file-attributes file))) + (when (or (> (- (car cur-time)(car last-accessed)) 1) + (and (eq (- (car cur-time)(car last-accessed)) 1) + (> (- (cadr cur-time)(cadr last-accessed)) + 64064))) ; 36 hours. + (message "Maildir: %d tmp file(s) are cleared." + (setq count (1+ count))) + (delete-file file))) + (directory-files (expand-file-name "tmp" dir) + t ; full + "^[^.].*$" t)))) + +(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 @@ -115,28 +280,42 @@ This variable should not be used in elsewhere.") ;; 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 + (elmo-maildir-adjust-separator ":2,[A-Z]*$") + (car news)) + (elmo-maildir-adjust-separator ":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 + (elmo-maildir-adjust-separator "^\\(.+:[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 + (elmo-maildir-adjust-separator ":2,") + (char-to-string mark)))) + t) (defun elmo-maildir-delete-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 (elmo-maildir-adjust-separator "^\\(.+:2,\\)\\(.*\\)$") + filename) + (let ((flaglist (string-to-char-list (elmo-match-string 2 filename)))) (when (memq mark flaglist) (setq flaglist (delq mark flaglist)) @@ -145,335 +324,286 @@ This variable should not be used in elsewhere.") (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)) - -(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 +(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) + +(defsubst elmo-maildir-set-mark-messages (folder locations mark remove) + (when mark + (if remove + (elmo-maildir-delete-mark-msgs folder locations mark) + (elmo-maildir-set-mark-msgs folder locations mark)))) + +(luna-define-method elmo-map-folder-set-flag ((folder elmo-maildir-folder) + locations flag) + (let ((spec (cdr (assq flag elmo-maildir-flag-specs)))) + (when spec + (elmo-maildir-set-mark-messages folder locations + (car spec) (nth 1 spec))))) + +(luna-define-method elmo-map-folder-unset-flag ((folder elmo-maildir-folder) + locations flag) + (let ((spec (cdr (assq flag elmo-maildir-flag-specs)))) + (when spec + (elmo-maildir-set-mark-messages folder locations + (car spec) (not (nth 1 spec)))))) + +(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 - ((>= 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." - (let ((cur-time (current-time))) - (format "%.0f.%d_%d.%s" - (+ (* (car cur-time) - (float 65536)) (cadr cur-time)) - (emacs-pid) - (incf elmo-maildir-sequence-number-internal) - (system-name))))) - ((eq emacs-major-version 18) - ;; A fake function for v18 - (defun elmo-maildir-make-unique-string () - "This function generates a string that can be used as a unique + 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) + +(defun elmo-maildir-sequence-number (file) + "Get `elmo-maildir' specific sequence number from FILE. +Not that FILE is the name without directory." + ;; elmo-maildir specific. + (if (string-match "^.*_\\([0-9]+\\)\\..*" file) + (string-to-number (match-string 1 file)) + -1)) + +(defun elmo-maildir-make-unique-string () + "This function generates a string that can be used as a unique file name for maildir directories." - (unless (fboundp 'float-to-string) - (load-library "float")) - (let ((time (current-time))) - (format "%s%d.%d.%s" - (substring - (float-to-string - (f+ (f* (f (car time)) - (f 65536)) - (f (cadr time)))) - 0 5) - (cadr time) - (% (abs (random t)) 10000); dummy pid - (system-name)))))) + (let ((cur-time (current-time))) + (format "%.0f.%d_%d.%s" + (+ (* (car cur-time) + (float 65536)) (cadr cur-time)) + (emacs-pid) + (incf elmo-maildir-sequence-number-internal) + (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) +(defun elmo-maildir-move-file (src dst) + (or (condition-case nil + (progn + ;; 1. Try add-link-to-file, then delete the original. + ;; This is safe on NFS. + (add-name-to-file src dst) + (ignore-errors + ;; It's ok if the delete-file fails; + ;; elmo-maildir-cleanup-temporal will catch it later. + (delete-file src)) + t) + (error)) + ;; 2. Even on systems with hardlinks, some filesystems (like AFS) + ;; might not support them, so fall back on rename-file. This is + ;; our best shot at atomic when add-name-to-file fails. + (rename-file src dst))) + +(luna-define-method elmo-folder-append-buffer ((folder elmo-maildir-folder) + &optional flags 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 + (elmo-maildir-move-file filename - (expand-file-name + (expand-file-name (concat "new/" (file-name-nondirectory filename)) basedir)) + (elmo-folder-preserve-flags + folder (elmo-msgdb-get-message-id-from-buffer) flags) 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 (or start-number 0))) + (dolist (number numbers) + (elmo-copy-file + (elmo-message-file-name folder number) + (expand-file-name + (number-to-string (if start-number cur-number number)) + temp-dir)) + (incf cur-number)) + temp-dir)) + +(defun elmo-folder-append-messages-*-maildir (folder + src-folder + numbers + same-number) + (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder)))) + (dir (elmo-maildir-folder-directory-internal folder)) + (table (elmo-folder-flag-table folder)) + (succeeds numbers) + filename flags id) + (dolist (number numbers) + (setq flags (elmo-message-flags src-folder number) + filename (elmo-maildir-temporal-filename dir)) + (elmo-copy-file + (elmo-message-file-name src-folder number) + filename) + (elmo-maildir-move-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 number + 'message-id))) + (elmo-flag-table-set table id flags)) + (elmo-progress-notify 'elmo-folder-move-messages)) + (when (elmo-folder-persistent-p folder) + (elmo-folder-close-flag-table folder)) + succeeds)) + +(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)))) + t) + +(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-raw-text file) + (unless unseen + (elmo-map-folder-set-flag folder (list location) 'read)) + t))) + +(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