X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-localdir.el;h=78a30f1c75499b668b5242ae60ffcab68277f601;hb=b3014a35763a3e607a0a6850b20ed1564639774a;hp=32e012574194cd68b0fbdc58f5aa0274bd500e97;hpb=d9e2a1d256315bb9d148e2d1996f0c8c693d1d84;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el index 32e0125..78a30f1 100644 --- a/elmo/elmo-localdir.el +++ b/elmo/elmo-localdir.el @@ -46,7 +46,7 @@ ;;; 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)) @@ -86,26 +86,30 @@ (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 @@ -130,17 +134,18 @@ (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 @@ -148,27 +153,18 @@ (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) @@ -181,7 +177,7 @@ 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))) @@ -195,55 +191,56 @@ (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) @@ -261,9 +258,9 @@ (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) @@ -316,39 +313,30 @@ (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))) @@ -356,12 +344,6 @@ (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)) @@ -371,6 +353,8 @@ (throw 'found t)) (setq lock (cdr lock))))))) +(autoload 'elmo-global-flags-set "elmo-flag") + (require 'product) (product-provide (provide 'elmo-localdir) (require 'elmo-version))