;;; ELMO Local directory folder
(eval-and-compile
- (luna-define-class elmo-localdir-folder (elmo-folder)
+ (luna-define-class elmo-localdir-folder (elmo-folder elmo-file-tag)
(dir-name directory))
(luna-define-internal-accessors 'elmo-localdir-folder))
(luna-define-method elmo-folder-expand-msgdb-path ((folder
elmo-localdir-folder))
- (expand-file-name
- (mapconcat
- 'identity
- (mapcar
- 'elmo-replace-string-as-filename
- (split-string
- (let ((dir-name (elmo-localdir-folder-dir-name-internal folder)))
- (if (file-name-absolute-p dir-name)
- (expand-file-name dir-name)
- dir-name))
- "/"))
- "/")
- (expand-file-name ;;"localdir"
- (symbol-name (elmo-folder-type-internal folder))
- elmo-msgdb-directory)))
+ (let* ((dir-name (elmo-localdir-folder-dir-name-internal folder))
+ (path (mapconcat
+ 'identity
+ (delete ""
+ (mapcar
+ 'elmo-replace-string-as-filename
+ (split-string
+ (if (file-name-absolute-p dir-name)
+ (expand-file-name dir-name)
+ dir-name)
+ "/")))
+ "/")))
+ (expand-file-name
+ path
+ (expand-file-name ;;"localdir" or "localdir-abs"
+ (concat
+ (symbol-name (elmo-folder-type-internal folder))
+ (when (file-name-absolute-p dir-name) "-abs"))
+ elmo-msgdb-directory))))
(luna-define-method elmo-message-file-name ((folder
elmo-localdir-folder)
number)
- (expand-file-name (int-to-string number)
+ (expand-file-name (number-to-string number)
(elmo-localdir-folder-directory-internal folder)))
(luna-define-method elmo-folder-message-file-number-p ((folder
(dolist (number numbers)
(elmo-copy-file
(expand-file-name
- (int-to-string number)
+ (number-to-string number)
(elmo-localdir-folder-directory-internal folder))
(expand-file-name
- (int-to-string (if start-number cur-number number))
+ (number-to-string (if start-number cur-number number))
temp-dir))
(incf cur-number))
temp-dir))
-(defun elmo-localdir-msgdb-create-entity (dir number)
- (elmo-msgdb-create-overview-entity-from-file
- number (expand-file-name (int-to-string number) dir)))
+(defun elmo-localdir-msgdb-create-entity (msgdb dir number)
+ (elmo-msgdb-create-message-entity-from-file
+ (elmo-msgdb-message-entity-handler msgdb)
+ number (expand-file-name (number-to-string number) dir)))
(luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder)
numbers
(when numbers
(let ((dir (elmo-localdir-folder-directory-internal folder))
(new-msgdb (elmo-make-msgdb))
- entity message-id
- (i 0)
- (len (length numbers)))
- (message "Creating msgdb...")
- (while numbers
- (setq entity
- (elmo-localdir-msgdb-create-entity
- dir (car numbers)))
- (when entity
- (setq message-id (elmo-msgdb-overview-entity-get-id entity))
- (elmo-msgdb-append-entity
- new-msgdb
- entity
- (elmo-flag-table-get flag-table message-id)))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-localdir-msgdb-create-as-numbers "Creating msgdb..."
- (/ (* i 100) len)))
- (setq numbers (cdr numbers)))
- (message "Creating msgdb...done")
+ entity message-id flags)
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
+ "Creating msgdb"
+ (dolist (number numbers)
+ (setq entity (elmo-localdir-msgdb-create-entity
+ new-msgdb dir number))
+ (when entity
+ (setq message-id (elmo-message-entity-field entity 'message-id)
+ flags (elmo-flag-table-get flag-table message-id))
+ (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)))
(luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder)
one-level)))
(defsubst elmo-localdir-list-subr (folder &optional nonsort)
- (let ((flist (mapcar 'string-to-int
+ (let ((flist (mapcar 'string-to-number
(directory-files
(elmo-localdir-folder-directory-internal folder)
nil "^[0-9]+$" t)))
(sort flist '<))))
(luna-define-method elmo-folder-append-buffer ((folder elmo-localdir-folder)
- unread
- &optional number)
+ &optional flags number)
(let ((filename (elmo-message-file-name
folder
(or number
(1+ (car (elmo-folder-status folder)))))))
- (when (file-writable-p filename)
+ (when (and (file-writable-p filename)
+ (not (file-exists-p filename)))
(write-region-as-binary
(point-min) (point-max) filename nil 'no-msg)
+ (elmo-folder-preserve-flags
+ folder (elmo-msgdb-get-message-id-from-buffer) flags)
t)))
-(luna-define-method elmo-folder-append-messages :around
- ((folder elmo-localdir-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-localdir-folder-directory-internal folder))
- (table (elmo-flag-table-load (elmo-folder-msgdb-path folder)))
- (succeeds numbers)
- (next-num (1+ (car (elmo-folder-status folder))))
- flags id)
- (while numbers
- (setq flags (elmo-message-flags src-folder (car numbers)))
- (elmo-copy-file
- (elmo-message-file-name src-folder (car numbers))
- (expand-file-name
- (int-to-string
- (if same-number (car numbers) next-num))
- dir))
- ;; save flag-table only when 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 flags))
- (elmo-progress-notify 'elmo-folder-move-messages)
- (if (and (setq numbers (cdr numbers))
- (not same-number))
- (setq next-num
- (if (elmo-localdir-locked-p)
- ;; MDA is running.
- (1+ (car (elmo-folder-status folder)))
- (1+ next-num)))))
- (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-folder-delete-messages ((folder elmo-localdir-folder)
- numbers)
+(defun elmo-folder-append-messages-*-localdir (folder
+ src-folder
+ numbers
+ same-number)
+ (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
+ (dir (elmo-localdir-folder-directory-internal folder))
+ (table (elmo-folder-flag-table folder))
+ (succeeds numbers)
+ (next-num (1+ (car (elmo-folder-status folder))))
+ flags id)
+ (while numbers
+ (setq flags (elmo-message-flags src-folder (car numbers)))
+ (elmo-copy-file
+ (elmo-message-file-name src-folder (car numbers))
+ (expand-file-name
+ (number-to-string
+ (if same-number (car numbers) next-num))
+ dir))
+ ;; save flag-table only when 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 flags))
+ (elmo-progress-notify 'elmo-folder-move-messages)
+ (if (and (setq numbers (cdr numbers))
+ (not same-number))
+ (setq next-num
+ (if (elmo-localdir-locked-p)
+ ;; MDA is running.
+ (1+ (car (elmo-folder-status folder)))
+ (1+ next-num)))))
+ (when (elmo-folder-persistent-p folder)
+ (elmo-folder-close-flag-table folder))
+ succeeds))
+
+(luna-define-method elmo-folder-delete-messages-internal
+ ((folder elmo-localdir-folder) numbers)
(dolist (number numbers)
(elmo-localdir-delete-message folder number))
t)
(luna-define-method elmo-message-fetch-internal ((folder elmo-localdir-folder)
number strategy
&optional section unread)
- (when (file-exists-p (elmo-message-file-name folder number))
- (insert-file-contents-as-binary
- (elmo-message-file-name folder number))))
+ (let ((filename (elmo-message-file-name folder number)))
+ (when (file-exists-p filename)
+ (insert-file-contents-as-raw-text filename))))
(luna-define-method elmo-folder-list-messages-internal
((folder elmo-localdir-folder) &optional nohide)
(rename-file old new)
t))
-(defsubst elmo-localdir-field-condition-match (folder condition
- number number-list)
- (elmo-file-field-condition-match
- (expand-file-name (int-to-string number)
- (elmo-localdir-folder-directory-internal folder))
- condition number number-list))
-
(luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder))
(let* ((dir (elmo-localdir-folder-directory-internal folder))
(msgdb (elmo-folder-msgdb folder))
- (new-msgdb (elmo-make-msgdb))
+ (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
(numbers (sort (elmo-folder-list-messages
folder
nil
(not elmo-pack-number-check-strict))
'<))
(new-number 1) ; first ordinal position in localdir
- total entity)
- (elmo-msgdb-set-path new-msgdb (elmo-folder-msgdb-path folder))
- (setq total (length numbers))
- (elmo-with-progress-display (> total elmo-display-progress-threshold)
- (elmo-folder-pack-numbers total "Packing...")
+ entity)
+ (elmo-with-progress-display (elmo-folder-pack-numbers (length numbers))
+ "Packing"
(dolist (old-number numbers)
(setq entity (elmo-msgdb-message-entity msgdb old-number))
(when (not (eq old-number new-number)) ; why \=() is wrong..
- (elmo-bind-directory
- dir
- ;; xxx nfs,hardlink
- (rename-file (int-to-string old-number)
- (int-to-string new-number) t))
- (elmo-msgdb-overview-entity-set-number entity new-number))
+ (elmo-bind-directory dir
+ ;; xxx nfs,hardlink
+ (rename-file (number-to-string old-number)
+ (number-to-string new-number) t))
+ (elmo-message-entity-set-number entity new-number))
(elmo-msgdb-append-entity new-msgdb entity
(elmo-msgdb-flags msgdb old-number))
+ (elmo-emit-signal 'message-number-changed folder old-number new-number)
(setq new-number (1+ new-number))))
(message "Packing...done")
(elmo-folder-set-msgdb-internal folder new-msgdb)))
(luna-define-method elmo-folder-message-file-p ((folder elmo-localdir-folder))
t)
-(luna-define-method elmo-message-file-name ((folder elmo-localdir-folder)
- number)
- (expand-file-name
- (int-to-string number)
- (elmo-localdir-folder-directory-internal folder)))
-
(defun elmo-localdir-locked-p ()
(if elmo-localdir-lockfile-list
(let ((lock elmo-localdir-lockfile-list))
(throw 'found t))
(setq lock (cdr lock)))))))
+(autoload 'elmo-global-flags-set "elmo-flag")
+
(require 'product)
(product-provide (provide 'elmo-localdir) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff