X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=elmo%2Felmo-localdir.el;h=fff92e8bb310dd3b0095e6d94c2e5714b82fcdf2;hb=d6f0f1d102813e2bf503ab8f524363dbd501ede4;hp=f9e5c2f1235231ac6f67b0c5d4b8cacd47173dc2;hpb=3823cb47f19c37a739371e84d76f051cdcc365bd;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el index f9e5c2f..fff92e8 100644 --- a/elmo/elmo-localdir.el +++ b/elmo/elmo-localdir.el @@ -89,10 +89,15 @@ (expand-file-name (mapconcat 'identity - (mapcar - 'elmo-replace-string-as-filename - (split-string (elmo-localdir-folder-dir-name-internal folder) - "/")) + (delete "" + (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)) @@ -134,53 +139,31 @@ (incf cur-number)) temp-dir)) -(defun elmo-localdir-msgdb-create-entity (dir number) - (elmo-msgdb-create-overview-entity-from-file +(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 (int-to-string number) dir))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder) numbers - new-mark - already-mark - seen-mark - important-mark - seen-list) + flag-table) (when numbers (let ((dir (elmo-localdir-folder-directory-internal folder)) - overview number-alist mark-alist entity message-id - num seen gmark + (new-msgdb (elmo-make-msgdb)) + entity message-id + flags (i 0) (len (length numbers))) (message "Creating msgdb...") (while numbers (setq entity (elmo-localdir-msgdb-create-entity - dir (car numbers))) - (if (null entity) - () - (setq num (elmo-msgdb-overview-entity-get-number entity)) - (setq overview - (elmo-msgdb-append-element - overview entity)) - (setq message-id (elmo-msgdb-overview-entity-get-id entity)) - (setq number-alist - (elmo-msgdb-number-add number-alist - num - message-id)) - (setq seen (member message-id seen-list)) - (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-exists-p message-id) ; XXX - (if seen - nil - already-mark) - (if seen - nil ;;seen-mark - new-mark)))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist - num - gmark)))) + new-msgdb dir (car numbers))) + (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 (car numbers) message-id) + (elmo-msgdb-append-entity new-msgdb entity flags)) (when (> len elmo-display-progress-threshold) (setq i (1+ i)) (elmo-display-progress @@ -188,7 +171,7 @@ (/ (* i 100) len))) (setq numbers (cdr numbers))) (message "Creating msgdb...done") - (list overview number-alist mark-alist)))) + new-msgdb))) (luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder) &optional one-level) @@ -214,31 +197,46 @@ (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) + (let* ((path (elmo-folder-msgdb-path folder)) + (table (elmo-flag-table-load path)) + (msgid (std11-field-body "message-id"))) + (when msgid + (elmo-flag-table-set table msgid flags) + (elmo-flag-table-save path table))) t))) (luna-define-method elmo-folder-append-messages :around ((folder elmo-localdir-folder) - src-folder numbers unread-marks &optional same-number) + src-folder numbers &optional same-number) (if (elmo-folder-message-file-p src-folder) - (let ((dir (elmo-localdir-folder-directory-internal 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))))) + (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)) @@ -247,6 +245,8 @@ ;; 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))) @@ -295,11 +295,19 @@ (elmo-make-directory dir)) t))) -(luna-define-method elmo-folder-delete :before ((folder elmo-localdir-folder)) - (let ((dir (elmo-localdir-folder-directory-internal folder))) - (if (not (file-directory-p dir)) - (error "No such directory: %s" dir) - (elmo-delete-directory dir t) +(luna-define-method elmo-folder-delete ((folder elmo-localdir-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 ((dir (elmo-localdir-folder-directory-internal folder))) + (if (not (file-directory-p dir)) + (error "No such directory: %s" dir) + (elmo-delete-match-files dir "[0-9]+" t))) + (elmo-msgdb-delete-path folder) t))) (luna-define-method elmo-folder-rename-internal ((folder elmo-localdir-folder) @@ -307,14 +315,14 @@ (let* ((old (elmo-localdir-folder-directory-internal folder)) (new (elmo-localdir-folder-directory-internal new-folder)) (new-dir (directory-file-name (file-name-directory new)))) - (if (not (file-directory-p old)) - (error "No such directory: %s" old) - (if (file-exists-p new) - (error "Already exists directory: %s" new) - (if (not (file-exists-p new-dir)) - (elmo-make-directory new-dir)) - (rename-file old new) - t)))) + (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)) (defsubst elmo-localdir-field-condition-match (folder condition number number-list) @@ -326,49 +334,31 @@ (luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder)) (let* ((dir (elmo-localdir-folder-directory-internal folder)) (msgdb (elmo-folder-msgdb folder)) - (onum-alist (elmo-msgdb-get-number-alist msgdb)) - (omark-alist (elmo-msgdb-get-mark-alist msgdb)) - (new-number 1) ; first ordinal position in localdir - flist onum mark new-mark-alist total) - (setq flist - (if elmo-pack-number-check-strict - (elmo-folder-list-messages folder) ; allow localnews - (mapcar 'car onum-alist))) - (setq total (length flist)) - (while flist - (when (> total elmo-display-progress-threshold) - (elmo-display-progress - 'elmo-folder-pack-numbers "Packing..." - (/ (* new-number 100) total))) - (setq onum (car flist)) - (when (not (eq onum new-number)) ; why \=() is wrong.. - (elmo-bind-directory - dir - ;; xxx nfs,hardlink - (rename-file (int-to-string onum) (int-to-string new-number) t)) - ;; update overview - (elmo-msgdb-overview-entity-set-number - (elmo-msgdb-overview-get-entity onum msgdb) - new-number) - ;; update number-alist - (setcar (assq onum onum-alist) new-number)) - ;; update mark-alist - (when (setq mark (cadr (assq onum omark-alist))) - (setq new-mark-alist - (elmo-msgdb-mark-append - new-mark-alist - new-number mark))) - (setq new-number (1+ new-number)) - (setq flist (cdr flist))) + (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) + (setq total (length numbers)) + (elmo-with-progress-display (> total elmo-display-progress-threshold) + (elmo-folder-pack-numbers total "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-message-entity-set-number entity new-number)) + (elmo-msgdb-append-entity new-msgdb entity + (elmo-msgdb-flags msgdb old-number)) + (setq new-number (1+ new-number)))) (message "Packing...done") - (elmo-folder-set-msgdb-internal - folder - (list (elmo-msgdb-get-overview msgdb) - onum-alist - new-mark-alist - ;; remake hash table - (elmo-msgdb-make-overview-hashtb - (elmo-msgdb-get-overview msgdb)))))) + (elmo-folder-set-msgdb-internal folder new-msgdb))) (luna-define-method elmo-folder-message-file-p ((folder elmo-localdir-folder)) t) @@ -388,6 +378,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))