From: hmurata Date: Sun, 14 Apr 2002 13:08:03 +0000 (+0000) Subject: * elmo-shimbun.el (elomo-shimbun-folder): Added entity-hash slot. X-Git-Tag: elmo-mark-root~205 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=f7e3011f46a52e8e6489b385de63231ef2ae7e14;p=elisp%2Fwanderlust.git * elmo-shimbun.el (elomo-shimbun-folder): Added entity-hash slot. (elmo-shimbun-folder-entity-hash): New function. (elmo-shimbun-folder-shimbun-header): Ditto. (elmo-shimbun-entity-to-header): Ditto. (elmo-shimbun-msgdb-to-headers): Removed. (elmo-shimbun-folder-setup): Ditto. (elmo-shimbun-folder-header-hash-setup): Don't use x-shimbun-id for hash key. (elmo-shimbun-get-headers): Set new headers only to slot. Don't call `elmo-shimbun-folder-header-hash-setup' if headers is nil. Removed useless local bind. (elmo-folder-open-internal): Don't call `elmo-shimbun-folder-setup'. (elmo-folder-close-internal): Clear entity-hash slot. (elmo-folder-clear): Ditto. (elmo-shimbun-msgdb-create-entity): Use `elmo-shimbun-folder-shimbun-header'. (elmo-map-message-fetch): Ditto. (elmo-shimbun-update-overview): Use overview entity instead of shimbun header to lookup id by references. (elmo-map-folder-list-message-locations): Use not only headers but also overviews to list locations. --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 5781373..d0d72f0 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,28 @@ +2002-04-14 Hiroya Murata + + * elmo-shimbun.el (elomo-shimbun-folder): Added entity-hash slot. + (elmo-shimbun-folder-entity-hash): New function. + (elmo-shimbun-folder-shimbun-header): Ditto. + (elmo-shimbun-entity-to-header): Ditto. + (elmo-shimbun-msgdb-to-headers): Removed. + (elmo-shimbun-folder-setup): Ditto. + (elmo-shimbun-folder-header-hash-setup): Don't use x-shimbun-id + for hash key. + (elmo-shimbun-get-headers): Set new headers only to slot. Don't + call `elmo-shimbun-folder-header-hash-setup' if headers is nil. + Removed useless local bind. + (elmo-folder-open-internal): Don't call + `elmo-shimbun-folder-setup'. + (elmo-folder-close-internal): Clear entity-hash slot. + (elmo-folder-clear): Ditto. + (elmo-shimbun-msgdb-create-entity): Use + `elmo-shimbun-folder-shimbun-header'. + (elmo-map-message-fetch): Ditto. + (elmo-shimbun-update-overview): Use overview entity instead of + shimbun header to lookup id by references. + (elmo-map-folder-list-message-locations): Use not only headers but + also overviews to list locations. + 2002-04-09 Hiroya Murata * elmo-net.el (elmo-folder-exists-p): If unplugged, guessed by diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index 332a7e6..0f4df88 100644 --- a/elmo/elmo-shimbun.el +++ b/elmo/elmo-shimbun.el @@ -96,9 +96,43 @@ update overview when message is fetched." (eval-and-compile (luna-define-class elmo-shimbun-folder (elmo-map-folder) (shimbun headers header-hash + entity-hash group range last-check)) (luna-define-internal-accessors 'elmo-shimbun-folder)) +(defun elmo-shimbun-folder-entity-hash (folder) + (or (elmo-shimbun-folder-entity-hash-internal folder) + (let ((overviews (elmo-msgdb-get-overview (elmo-folder-msgdb folder))) + hash id) + (when overviews + (setq hash (elmo-make-hash (length overviews))) + (dolist (entity overviews) + (elmo-set-hash-val (elmo-msgdb-overview-entity-get-id entity) + entity hash) + (when (setq id (elmo-msgdb-overview-entity-get-extra-field + entity "x-original-id")) + (elmo-set-hash-val id entity hash))) + (elmo-shimbun-folder-set-entity-hash-internal folder hash))))) + +(defsubst elmo-shimbun-folder-shimbun-header (folder location) + (let ((hash (elmo-shimbun-folder-header-hash-internal folder))) + (or (and hash (elmo-get-hash-val location hash)) + (let ((entity (elmo-msgdb-overview-get-entity + location + (elmo-folder-msgdb folder))) + (elmo-hash-minimum-size 63) + header) + (when entity + (setq header (elmo-shimbun-entity-to-header entity)) + (unless hash + (elmo-shimbun-folder-set-header-hash-internal + folder + (setq hash (elmo-make-hash)))) + (elmo-set-hash-val (elmo-msgdb-overview-entity-get-id entity) + header + hash) + header))))) + (defsubst elmo-shimbun-lapse-seconds (time) (let ((now (current-time))) (+ (* (- (car now) (car time)) 65536) @@ -119,65 +153,41 @@ update overview when message is fetched." (elmo-shimbun-folder-last-check-internal folder)) elmo-shimbun-check-interval)))) -(defun elmo-shimbun-msgdb-to-headers (folder expire-days) - (let (headers message-id shimbun-id) - (dolist (ov (elmo-msgdb-get-overview (elmo-folder-msgdb folder))) - (when (and (elmo-msgdb-overview-entity-get-extra-field ov "xref") - (if expire-days - (< (elmo-shimbun-lapse-seconds - (elmo-shimbun-parse-time-string - (elmo-msgdb-overview-entity-get-date ov))) - (* expire-days 86400 ; seconds per day - )) - t)) - (if (setq message-id (elmo-msgdb-overview-entity-get-extra-field - ov "x-original-id")) - (setq shimbun-id (elmo-msgdb-overview-entity-get-id ov)) - (setq message-id (elmo-msgdb-overview-entity-get-id ov) - shimbun-id nil)) - (setq headers - (cons (shimbun-make-header - (elmo-msgdb-overview-entity-get-number ov) - (shimbun-mime-encode-string - (elmo-msgdb-overview-entity-get-subject ov)) - (shimbun-mime-encode-string - (elmo-msgdb-overview-entity-get-from ov)) - (elmo-msgdb-overview-entity-get-date ov) - message-id - (elmo-msgdb-overview-entity-get-references ov) - 0 - 0 - (elmo-msgdb-overview-entity-get-extra-field ov "xref") - (and shimbun-id - (list (cons "x-shimbun-id" shimbun-id)))) - headers)))) - (nreverse headers))) +(defun elmo-shimbun-entity-to-header (entity) + (let (message-id shimbun-id) + (if (setq message-id (elmo-msgdb-overview-entity-get-extra-field + entity "x-original-id")) + (setq shimbun-id (elmo-msgdb-overview-entity-get-id entity)) + (setq message-id (elmo-msgdb-overview-entity-get-id entity) + shimbun-id nil)) + (shimbun-make-header + (elmo-msgdb-overview-entity-get-number entity) + (shimbun-mime-encode-string + (elmo-msgdb-overview-entity-get-subject entity)) + (shimbun-mime-encode-string + (elmo-msgdb-overview-entity-get-from entity)) + (elmo-msgdb-overview-entity-get-date entity) + message-id + (elmo-msgdb-overview-entity-get-references entity) + 0 + 0 + (elmo-msgdb-overview-entity-get-extra-field entity "xref") + (and shimbun-id + (list (cons "x-shimbun-id" shimbun-id)))))) (defsubst elmo-shimbun-folder-header-hash-setup (folder headers) - (let ((hash (elmo-make-hash (length headers))) - shimbun-id) + (let ((hash (or (elmo-shimbun-folder-header-hash-internal folder) + (elmo-make-hash (length headers))))) (dolist (header headers) - (elmo-set-hash-val (shimbun-header-id header) header hash) - (when (setq shimbun-id - (elmo-shimbun-header-extra-field header "x-shimbun-id")) - (elmo-set-hash-val shimbun-id header hash))) + (elmo-set-hash-val (shimbun-header-id header) header hash)) (elmo-shimbun-folder-set-header-hash-internal folder hash))) -(defun elmo-shimbun-folder-setup (folder) - ;; Resume headers from existing msgdb. - (elmo-shimbun-folder-set-headers-internal - folder - (elmo-shimbun-msgdb-to-headers folder nil)) - (elmo-shimbun-folder-header-hash-setup - folder - (elmo-shimbun-folder-headers-internal folder))) - (defun elmo-shimbun-get-headers (folder) (let* ((shimbun (elmo-shimbun-folder-shimbun-internal folder)) (key (concat (shimbun-server-internal shimbun) "." (shimbun-current-group-internal shimbun))) (elmo-hash-minimum-size 0) - entry headers hash) + headers) ;; new headers. (setq headers (delq nil @@ -191,15 +201,9 @@ update overview when message is fetched." (shimbun-headers (elmo-shimbun-folder-shimbun-internal folder) (elmo-shimbun-folder-range-internal folder))))) - (elmo-shimbun-folder-set-headers-internal - folder - (nconc (elmo-shimbun-msgdb-to-headers - folder (shimbun-article-expiration-days - (elmo-shimbun-folder-shimbun-internal folder))) - headers)) - (elmo-shimbun-folder-header-hash-setup - folder - (elmo-shimbun-folder-headers-internal folder)) + (elmo-shimbun-folder-set-headers-internal folder headers) + (when headers + (elmo-shimbun-folder-header-hash-setup folder headers)) (elmo-shimbun-folder-set-last-check-internal folder (current-time)))) (luna-define-method elmo-folder-initialize ((folder @@ -233,16 +237,13 @@ update overview when message is fetched." (unless (elmo-map-folder-location-alist-internal folder) (elmo-map-folder-location-setup folder - (elmo-msgdb-location-load (elmo-folder-msgdb-path folder))))) - (cond ((and (elmo-folder-plugged-p folder) - (elmo-shimbun-headers-check-p folder)) - (elmo-shimbun-get-headers folder) - (elmo-map-folder-update-locations - folder - (elmo-map-folder-list-message-locations folder))) - ((null (elmo-shimbun-folder-headers-internal folder)) - ;; Resume headers from existing msgdb. - (elmo-shimbun-folder-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 + folder + (elmo-map-folder-list-message-locations folder))))) (luna-define-method elmo-folder-reserve-status-p ((folder elmo-shimbun-folder)) t) @@ -259,6 +260,8 @@ update overview when message is fetched." folder nil) (elmo-shimbun-folder-set-header-hash-internal folder nil) + (elmo-shimbun-folder-set-entity-hash-internal + folder nil) (elmo-shimbun-folder-set-last-check-internal folder nil)) @@ -298,6 +301,7 @@ update overview when message is fetched." &optional keep-killed) (elmo-shimbun-folder-set-headers-internal folder nil) (elmo-shimbun-folder-set-header-hash-internal folder nil) + (elmo-shimbun-folder-set-entity-hash-internal folder nil) (elmo-shimbun-folder-set-last-check-internal folder nil) (luna-call-next-method)) @@ -311,9 +315,9 @@ update overview when message is fetched." (expand-file-name "shimbun" elmo-msgdb-directory))) (defun elmo-shimbun-msgdb-create-entity (folder number) - (let ((header (elmo-get-hash-val - (elmo-map-message-location folder number) - (elmo-shimbun-folder-header-hash-internal folder))) + (let ((header (elmo-shimbun-folder-shimbun-header + folder + (elmo-map-message-location folder number))) ov) (when header (with-temp-buffer @@ -387,8 +391,11 @@ update overview when message is fetched." (elmo-shimbun-header-set-extra-field header "x-shimbun-id" shimbun-id) (elmo-set-hash-val message-id - header - (elmo-shimbun-folder-header-hash-internal folder))) + entity + (elmo-shimbun-folder-entity-hash folder)) + (elmo-set-hash-val shimbun-id + entity + (elmo-shimbun-folder-entity-hash folder))) (elmo-msgdb-overview-entity-set-from entity (elmo-mime-string (shimbun-header-from header))) @@ -404,20 +411,19 @@ update overview when message is fetched." (elmo-field-body "references")))) (elmo-msgdb-overview-entity-set-references entity - (or (elmo-shimbun-header-extra-field - (elmo-get-hash-val references - (elmo-shimbun-folder-header-hash-internal - folder)) - "x-shimbun-id") + (or (elmo-msgdb-overview-entity-get-id + (elmo-get-hash-val + references + (elmo-shimbun-folder-entity-hash folder))) references))))) (luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder) location strategy &optional section unseen) (if (elmo-folder-plugged-p folder) - (let ((header (elmo-get-hash-val - location - (elmo-shimbun-folder-header-hash-internal folder))) + (let ((header (elmo-shimbun-folder-shimbun-header + folder + location)) shimbun-id) (shimbun-article (elmo-shimbun-folder-shimbun-internal folder) header) @@ -449,11 +455,29 @@ update overview when message is fetched." (luna-define-method elmo-map-folder-list-message-locations ((folder elmo-shimbun-folder)) - (mapcar - (lambda (header) - (or (elmo-shimbun-header-extra-field header "x-shimbun-id") - (shimbun-header-id header))) - (elmo-shimbun-folder-headers-internal folder))) + (let ((expire-days (shimbun-article-expiration-days + (elmo-shimbun-folder-shimbun-internal folder)))) + (elmo-uniq-list + (nconc + (delq nil + (mapcar + (lambda (ov) + (when (and (elmo-msgdb-overview-entity-get-extra-field + ov "xref") + (if expire-days + (< (elmo-shimbun-lapse-seconds + (elmo-shimbun-parse-time-string + (elmo-msgdb-overview-entity-get-date ov))) + (* expire-days 86400 ; seconds per day + )) + t)) + (elmo-msgdb-overview-entity-get-id ov))) + (elmo-msgdb-get-overview (elmo-folder-msgdb folder)))) + (mapcar + (lambda (header) + (or (elmo-shimbun-header-extra-field header "x-shimbun-id") + (shimbun-header-id header))) + (elmo-shimbun-folder-headers-internal folder)))))) (luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder) &optional one-level)