X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-shimbun.el;h=889280ae20291b7a6a1489e8d42bce2fb2ea573f;hb=dc2fa85ae16caaccdfe5d961e4e40e81b24973cb;hp=bb5bc8823f724c3f159b6f4caf969fc5d6f033bd;hpb=55514c966f65aa4806bc74c750630a14743b88bd;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index bb5bc88..889280a 100644 --- a/elmo/elmo-shimbun.el +++ b/elmo/elmo-shimbun.el @@ -129,8 +129,7 @@ If it is the symbol `all', update overview for all shimbun folders." (elmo-shimbun-folder-set-header-hash-internal folder (setq hash (elmo-make-hash)))) - (elmo-set-hash-val (elmo-message-entity-field entity - 'message-id) + (elmo-set-hash-val (elmo-message-entity-field entity 'message-id) header hash) header))))) @@ -140,14 +139,6 @@ If it is the symbol `all', update overview for all shimbun folders." (+ (* (- (car now) (car time)) 65536) (- (nth 1 now) (nth 1 time))))) -(defun elmo-shimbun-parse-time-string (string) - "Parse the time-string STRING and return its time as Emacs style." - (ignore-errors - (let ((x (timezone-fix-time string nil nil))) - (encode-time (aref x 5) (aref x 4) (aref x 3) - (aref x 2) (aref x 1) (aref x 0) - (aref x 6))))) - (defsubst elmo-shimbun-headers-check-p (folder) (or (null (elmo-shimbun-folder-last-check-internal folder)) (and (elmo-shimbun-folder-last-check-internal folder) @@ -157,22 +148,20 @@ If it is the symbol `all', update overview for all shimbun folders." (defun elmo-shimbun-entity-to-header (entity) (let (message-id shimbun-id) - (if (setq message-id (elmo-message-entity-field - entity 'x-original-id)) + (if (setq message-id (elmo-message-entity-field entity 'x-original-id)) (setq shimbun-id (elmo-message-entity-field entity 'message-id)) (setq message-id (elmo-message-entity-field entity 'message-id) shimbun-id nil)) (elmo-with-enable-multibyte - (shimbun-make-header + (shimbun-create-header (elmo-message-entity-number entity) - (shimbun-mime-encode-string - (elmo-message-entity-field entity 'subject 'decode)) - (shimbun-mime-encode-string - (elmo-message-entity-field entity 'from 'decode)) - (elmo-message-entity-field entity 'date) + (elmo-message-entity-field entity 'subject) + (elmo-message-entity-field entity 'from) + (elmo-time-make-date-string + (elmo-message-entity-field entity 'date)) message-id (elmo-message-entity-field entity 'references) - 0 + (elmo-message-entity-field entity 'size) 0 (elmo-message-entity-field entity 'xref) (and shimbun-id @@ -241,14 +230,14 @@ If it is the symbol `all', update overview for all shimbun folders." (elmo-shimbun-folder-shimbun-internal folder) (elmo-shimbun-folder-group-internal folder)) (let ((inhibit-quit t)) - (unless (elmo-map-folder-location-alist-internal folder) - (elmo-map-folder-location-setup + (unless (elmo-location-map-alist folder) + (elmo-location-map-setup folder (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))) (when (and (elmo-folder-plugged-p folder) (elmo-shimbun-headers-check-p folder)) (elmo-shimbun-get-headers folder) - (elmo-map-folder-update-locations + (elmo-location-map-update folder (elmo-map-folder-list-message-locations folder)))))) @@ -347,73 +336,47 @@ If it is the symbol `all', update overview for all shimbun folders." (luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder) numlist flag-table) (let ((new-msgdb (elmo-make-msgdb)) - entity i percent length msgid flags) - (setq length (length numlist)) - (setq i 0) - (message "Creating msgdb...") - (while numlist - (setq entity - (elmo-shimbun-msgdb-create-entity - folder (car numlist))) - (when entity - (setq msgid (elmo-message-entity-field entity 'message-id) - flags (elmo-flag-table-get flag-table msgid)) - (elmo-global-flags-set flags folder (car numlist) msgid) - (elmo-msgdb-append-entity new-msgdb entity flags)) - (when (> length elmo-display-progress-threshold) - (setq i (1+ i)) - (setq percent (/ (* i 100) length)) - (elmo-display-progress - 'elmo-folder-msgdb-create "Creating msgdb..." - percent)) - (setq numlist (cdr numlist))) - (message "Creating msgdb...done") - (elmo-msgdb-sort-by-date new-msgdb))) + entity msgid flags) + (elmo-with-progress-display (elmo-folder-msgdb-create (length numlist)) + "Creating msgdb" + (dolist (number numlist) + (setq entity (elmo-shimbun-msgdb-create-entity folder number)) + (when entity + (setq msgid (elmo-message-entity-field entity 'message-id) + flags (elmo-flag-table-get flag-table msgid)) + (elmo-global-flags-set flags folder number msgid) + (elmo-msgdb-append-entity new-msgdb entity flags)) + (elmo-progress-notify 'elmo-folder-msgdb-create))) + new-msgdb)) (luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder)) nil) -(defsubst elmo-shimbun-update-overview (folder shimbun-id header) - (let ((entity (elmo-message-entity folder shimbun-id)) - (message-id (shimbun-header-id header)) +(defsubst elmo-shimbun-update-overview (folder entity shimbun-id header) + (let ((message-id (shimbun-header-id header)) references) - (unless (string= shimbun-id message-id) - (elmo-message-entity-set-field - entity 'x-original-id message-id) - (elmo-shimbun-header-set-extra-field - header "x-shimbun-id" shimbun-id) - (elmo-set-hash-val message-id - entity - (elmo-shimbun-folder-entity-hash folder)) - (elmo-set-hash-val shimbun-id - entity - (elmo-shimbun-folder-entity-hash folder))) - (elmo-message-entity-set-field - entity - 'from - (elmo-mime-string (shimbun-header-from header))) - (elmo-message-entity-set-field - entity - 'subject - (elmo-mime-string (shimbun-header-subject header))) - (elmo-message-entity-set-field - entity - 'date - (shimbun-header-date header)) - (when (setq references - (or (elmo-msgdb-get-last-message-id - (elmo-field-body "in-reply-to")) - (elmo-msgdb-get-last-message-id - (elmo-field-body "references")))) - (elmo-message-entity-set-field - entity - 'references - (or (elmo-message-entity-field - (elmo-get-hash-val - references - (elmo-shimbun-folder-entity-hash folder)) - 'message-id) - references))))) + (when (elmo-msgdb-update-entity + (elmo-folder-msgdb folder) + entity + (nconc + (unless (string= shimbun-id message-id) + (elmo-shimbun-header-set-extra-field + header "x-shimbun-id" shimbun-id) + (elmo-set-hash-val message-id + entity + (elmo-shimbun-folder-entity-hash folder)) + (elmo-set-hash-val shimbun-id + entity + (elmo-shimbun-folder-entity-hash folder)) + (list (cons 'x-original-id message-id))) + (list + (cons 'from (shimbun-header-from header 'no-encode)) + (cons 'subject (shimbun-header-subject header 'no-encode)) + (cons 'date (shimbun-header-date header)) + (cons 'references + (elmo-msgdb-get-references-from-buffer))))) + (elmo-emit-signal 'update-overview folder + (elmo-message-entity-number entity))))) (luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder) location strategy @@ -429,7 +392,9 @@ If it is the symbol `all', update overview for all shimbun folders." (elmo-string-match-member (elmo-folder-name-internal folder) elmo-shimbun-update-overview-folder-list)) - (elmo-shimbun-update-overview folder location header)) + (let ((entity (elmo-message-entity folder location))) + (when entity + (elmo-shimbun-update-overview folder entity location header)))) (when (setq shimbun-id (elmo-shimbun-header-extra-field header "x-shimbun-id")) (goto-char (point-min)) @@ -464,8 +429,7 @@ If it is the symbol `all', update overview for all shimbun folders." (when (and (elmo-message-entity-field ov 'xref) (if expire-days (< (elmo-shimbun-lapse-seconds - (elmo-shimbun-parse-time-string - (elmo-message-entity-field ov 'date))) + (elmo-message-entity-field ov 'date)) (* expire-days 86400 ; seconds per day )) t)) @@ -500,15 +464,10 @@ If it is the symbol `all', update overview for all shimbun folders." (setq folders (append folders (mapcar - (lambda (fld) (concat prefix server "." fld)) + (lambda (group) (concat prefix server "." group)) (shimbun-groups - (shimbun-open server - (let ((fld - (elmo-make-folder - (concat prefix server)))) - (luna-make-entity - 'shimbun-elmo-mua - :folder fld)))))))) + (elmo-shimbun-folder-shimbun-internal + (elmo-get-folder (concat prefix server)))))))) folders))))) (luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder)) @@ -526,6 +485,13 @@ If it is the symbol `all', update overview for all shimbun folders." (elmo-folder-kill-messages folder numbers) t) +(luna-define-method elmo-message-entity-parent ((folder elmo-shimbun-folder) + entity) + (let ((references (elmo-message-entity-field entity 'references))) + (and references + (elmo-get-hash-val references + (elmo-shimbun-folder-entity-hash folder))))) + (require 'product) (product-provide (provide 'elmo-shimbun) (require 'elmo-version))