;;; 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))
(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)
(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."
(make-directory (file-name-directory filename)))
(while (file-exists-p filename)
;;; I don't want to wait.
-;;; (sleep-for 2)
+;;; (sleep-for 2)
(setq filename
(expand-file-name
(concat "tmp/" (elmo-maildir-make-unique-string))
&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)))
+ (number-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)
&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)))
projects / elisp / wanderlust.git / blobdiff