X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-maildir.el;h=9e1ee2829e01a81ba8d7f9a8b619e21e1778c355;hb=382d7519f582a3d8dc6b524b5bf002510bcc9338;hp=9632959cd226bdfcfbc40ea76e1457aef33e9964;hpb=9c79e37f8377b35f35f5830a1186443486e506ff;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-maildir.el b/elmo/elmo-maildir.el index 9632959..9e1ee28 100644 --- a/elmo/elmo-maildir.el +++ b/elmo/elmo-maildir.el @@ -64,7 +64,7 @@ but some file systems don't support colons in filenames." ;;; ELMO Maildir folder (eval-and-compile (luna-define-class elmo-maildir-folder - (elmo-map-folder) + (elmo-map-folder elmo-file-tag) (directory unread-locations flagged-locations answered-locations)) @@ -110,43 +110,44 @@ LOCATION." (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)) + (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 (elmo-get-last-modification-time - (expand-file-name x cur-dir)) - y-time (elmo-get-last-modification-time - (expand-file-name y cur-dir))) + (setq x-time (cdr x) + y-time (cdr y)) (cond ((< x-time y-time) t) ((eq x-time y-time) - (< (elmo-maildir-sequence-number x) - (elmo-maildir-sequence-number y))))))) + (< (elmo-maildir-sequence-number (car x)) + (elmo-maildir-sequence-number (car y)))))))) (setq locations (mapcar (lambda (x) - (if (string-match - (elmo-maildir-adjust-separator "^\\([^:]+\\):\\([^:]+\\)$") - x) - (progn - (setq sym (elmo-match-string 1 x) - flag-list (string-to-char-list - (elmo-match-string 2 x))) - (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) - 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)) (list locations unread-locations flagged-locations answered-locations))) @@ -175,84 +176,78 @@ LOCATION." (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)) - (new-msgdb (elmo-make-msgdb)) - (i 0) - entity message-id flags location) - (message "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) - (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") + (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) @@ -261,19 +256,19 @@ LOCATION." (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)))) + (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." @@ -300,7 +295,7 @@ LOCATION." (defun elmo-maildir-set-mark (filename mark) "Mark the FILENAME file in the maildir. MARK is a character." (if (string-match - (elmo-maildir-adjust-separator "^\\([^:]+:[12],\\)\\(.*\\)$") + (elmo-maildir-adjust-separator "^\\(.+:[12],\\)\\(.*\\)$") filename) (let ((flaglist (string-to-char-list (elmo-match-string 2 filename)))) @@ -318,7 +313,7 @@ LOCATION." (defun elmo-maildir-delete-mark (filename mark) "Mark the FILENAME file in the maildir. MARK is a character." - (if (string-match (elmo-maildir-adjust-separator "^\\([^:]+:2,\\)\\(.*\\)$") + (if (string-match (elmo-maildir-adjust-separator "^\\(.+:2,\\)\\(.*\\)$") filename) (let ((flaglist (string-to-char-list (elmo-match-string 2 filename)))) @@ -477,45 +472,45 @@ file name for maildir directories." &optional start-number) (let ((temp-dir (elmo-folder-make-temporary-directory folder)) - (cur-number (if start-number 0))) + (cur-number (or 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))) + (int-to-string (if start-number cur-number number)) + temp-dir)) + (incf cur-number)) 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-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-call-next-method))) +(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) @@ -533,7 +528,7 @@ file name for maildir directories." &optional section unseen) (let ((file (elmo-maildir-message-file-name folder location))) (when (file-exists-p file) - (insert-file-contents-as-binary file) + (insert-file-contents-as-raw-text file) (unless unseen (elmo-map-folder-set-flag folder (list location) 'read)) t)))