(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)
(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))
+ (elmo-set-work-buf
+ (set-buffer-multibyte t)
+ (shimbun-make-header
+ (elmo-msgdb-overview-entity-get-number entity)
+ (shimbun-mime-encode-string
+ (decode-mime-charset-string
+ (elmo-msgdb-overview-entity-get-subject-no-decode entity)
+ elmo-mime-charset))
+ (shimbun-mime-encode-string
+ (decode-mime-charset-string
+ (elmo-msgdb-overview-entity-get-from-no-decode entity)
+ elmo-mime-charset))
+ (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)
+ (elmo-hash-minimum-size 63)
+ headers)
;; new headers.
(setq headers
(delq nil
(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
(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)
+(luna-define-method elmo-folder-local-p ((folder elmo-shimbun-folder))
+ nil)
+
(luna-define-method elmo-message-use-cache-p ((folder elmo-shimbun-folder)
number)
elmo-shimbun-use-cache)
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))
&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))
(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
(list (cons "xref" (shimbun-header-xref header)))))))))
(luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
- numlist new-mark
- already-mark seen-mark
- important-mark
- seen-list)
+ numlist seen-list)
(let* (overview number-alist mark-alist entity
i percent number length pair msgid gmark seen)
(setq length (length numlist))
(if (setq gmark (or (elmo-msgdb-global-mark-get msgid)
(if (elmo-file-cache-status
(elmo-file-cache-get msgid))
- (if seen nil already-mark)
+ (if seen nil elmo-msgdb-unread-cached-mark)
(if seen
(if elmo-shimbun-use-cache
- seen-mark)
- new-mark))))
+ elmo-msgdb-read-uncached-mark)
+ elmo-msgdb-new-mark))))
(setq mark-alist
(elmo-msgdb-mark-append mark-alist
number gmark))))
(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)))
(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)
(when (setq shimbun-id
(elmo-shimbun-header-extra-field header "x-shimbun-id"))
(goto-char (point-min))
- (insert (format "X-Shimbun-Id: %s\n" shimbun-id))))
+ (insert (format "X-Shimbun-Id: %s\n" shimbun-id)))
+ t)
(error "Unplugged")))
(luna-define-method elmo-message-encache :around ((folder
(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)
folder))))
t))
-(luna-define-method elmo-folder-search ((folder elmo-shimbun-folder)
- condition &optional from-msgs)
- nil)
-
-;;; To override elmo-map-folder methods.
-(luna-define-method elmo-folder-list-unreads-internal
- ((folder elmo-shimbun-folder) unread-marks &optional mark-alist)
- t)
-
-(luna-define-method elmo-folder-unmark-important ((folder elmo-shimbun-folder)
- numbers)
- t)
-
-(luna-define-method elmo-folder-mark-as-important ((folder elmo-shimbun-folder)
- numbers)
- t)
-
-(luna-define-method elmo-folder-unmark-read ((folder elmo-shimbun-folder)
- numbers)
- t)
-
-(luna-define-method elmo-folder-mark-as-read ((folder elmo-shimbun-folder)
- numbers)
- t)
-
(require 'product)
(product-provide (provide 'elmo-shimbun) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff