(require 'elmo-map)
(require 'shimbun)
+(defcustom elmo-shimbun-check-interval 60
+ "*Check interval for shimbun."
+ :type 'integer
+ :group 'elmo)
+
+;; Internal variable.
+;; A list of elements like:
+;; ("server.group" . [header-list header-hash last-check]).
+(defvar elmo-shimbun-headers-cache nil)
+
(eval-and-compile
(luna-define-class elmo-shimbun-folder
- (elmo-map-folder) (shimbun header-hash group))
+ (elmo-map-folder) (shimbun headers header-hash group))
(luna-define-internal-accessors 'elmo-shimbun-folder))
+(defsubst elmo-shimbun-headers-cache-header-list (entry)
+ (aref entry 0))
+
+(defsubst elmo-shimbun-headers-cache-set-header-list (entry list)
+ (aset entry 0 list))
+
+(defsubst elmo-shimbun-headers-cache-header-hash (entry)
+ (aref entry 1))
+
+(defsubst elmo-shimbun-headers-cache-set-header-hash (entry hash)
+ (aset entry 1 hash))
+
+(defsubst elmo-shimbun-headers-cache-last-check (entry)
+ (aref entry 2))
+
+(defsubst elmo-shimbun-headers-cache-set-last-check (entry time)
+ (aset entry 2 time))
+
+(defsubst elmo-shimbun-lapse-seconds (time)
+ (let ((now (current-time)))
+ (+ (* (- (car now) (car time)) 65536)
+ (- (nth 1 now) (nth 1 time)))))
+
+(defsubst elmo-shimbun-headers-cache-check-p (cache)
+ (or (null (elmo-shimbun-headers-cache-last-check cache))
+ (and (elmo-shimbun-headers-cache-last-check cache)
+ (> (elmo-shimbun-lapse-seconds
+ (elmo-shimbun-headers-cache-last-check cache))
+ elmo-shimbun-check-interval))))
+
+(defun elmo-shimbun-get-headers (folder)
+ (shimbun-open-group
+ (elmo-shimbun-folder-shimbun-internal folder)
+ (elmo-shimbun-folder-group-internal 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 done)
+ (if (setq entry (cdr (assoc key elmo-shimbun-headers-cache)))
+ (unless (elmo-shimbun-headers-cache-check-p entry)
+ (elmo-shimbun-folder-set-headers-internal
+ folder
+ (elmo-shimbun-headers-cache-header-list entry))
+ (elmo-shimbun-folder-set-header-hash-internal
+ folder
+ (elmo-shimbun-headers-cache-header-hash entry))
+ (elmo-shimbun-headers-cache-header-list entry)
+ (setq done t)))
+ (unless done
+ (setq headers
+ (elmo-shimbun-folder-set-headers-internal
+ folder (shimbun-headers
+ (elmo-shimbun-folder-shimbun-internal folder))))
+ (setq hash
+ (elmo-shimbun-folder-set-header-hash-internal
+ folder
+ (elmo-make-hash
+ (length (elmo-shimbun-folder-headers-internal folder)))))
+ ;; Set up header hash.
+ (dolist (header (elmo-shimbun-folder-headers-internal folder))
+ (elmo-set-hash-val
+ (shimbun-header-id header) header
+ (elmo-shimbun-folder-header-hash-internal folder)))
+ (if entry
+ (progn
+ (elmo-shimbun-headers-cache-set-header-list entry headers)
+ (elmo-shimbun-headers-cache-set-header-hash entry hash)
+ (elmo-shimbun-headers-cache-set-last-check entry (current-time)))
+ (setq elmo-shimbun-headers-cache
+ (cons (cons key (vector headers hash (current-time)))
+ elmo-shimbun-headers-cache))))))
+
(luna-define-method elmo-folder-initialize ((folder
elmo-shimbun-folder)
name)
- (let ((server-group (split-string name "\\.")))
+ (let ((server-group (if (string-match "\\([^.]+\\)\\." name)
+ (list (elmo-match-string 1 name)
+ (substring name (match-end 0)))
+ (list name))))
(if (nth 0 server-group) ; server
(elmo-shimbun-folder-set-shimbun-internal
folder
(luna-define-method elmo-folder-open-internal :before ((folder
elmo-shimbun-folder))
- (shimbun-open-group
- (elmo-shimbun-folder-shimbun-internal folder)
- (elmo-shimbun-folder-group-internal folder))
- (elmo-shimbun-folder-set-header-hash-internal
- folder
- (elmo-make-hash (length (shimbun-headers
- (elmo-shimbun-folder-shimbun-internal folder)))))
- ;; Set up header hash.
- (dolist (header (shimbun-headers (elmo-shimbun-folder-shimbun-internal
- folder)))
- (elmo-set-hash-val
- (shimbun-header-id header) header
- (elmo-shimbun-folder-header-hash-internal folder))))
+ (when (elmo-folder-plugged-p folder)
+ (elmo-shimbun-get-headers folder)))
(luna-define-method elmo-folder-close-internal :after ((folder
elmo-shimbun-folder))
(shimbun-close-group
(elmo-shimbun-folder-shimbun-internal folder))
+ (elmo-shimbun-folder-set-headers-internal
+ folder nil)
(elmo-shimbun-folder-set-header-hash-internal
folder nil))
+(luna-define-method elmo-folder-plugged-p ((folder elmo-shimbun-folder))
+ (elmo-plugged-p
+ "shimbun"
+ (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))
+ nil nil
+ (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))))
+
+(luna-define-method elmo-folder-set-plugged ((folder elmo-shimbun-folder)
+ plugged &optional add)
+ (elmo-set-plugged plugged
+ "shimbun"
+ (shimbun-server-internal
+ (elmo-shimbun-folder-shimbun-internal folder))
+ nil nil nil
+ (shimbun-server-internal
+ (elmo-shimbun-folder-shimbun-internal folder))
+ add))
+
(luna-define-method elmo-folder-check :after ((folder elmo-shimbun-folder))
- (shimbun-close-group
- (elmo-shimbun-folder-shimbun-internal folder))
- (shimbun-open-group
- (elmo-shimbun-folder-shimbun-internal folder)
- (elmo-shimbun-folder-group-internal folder)))
+ (when (shimbun-current-group-internal
+ (elmo-shimbun-folder-shimbun-internal folder))
+ ;; Discard current headers information.
+ (elmo-folder-close-internal folder)
+ (elmo-folder-open-internal folder)))
(luna-define-method elmo-folder-expand-msgdb-path ((folder
elmo-shimbun-folder))
(expand-file-name "shimbun" elmo-msgdb-dir)))
(defun elmo-shimbun-msgdb-create-entity (folder number)
- (with-temp-buffer
- (shimbun-header-insert
- (elmo-get-hash-val
- (elmo-map-message-location folder number)
- (elmo-shimbun-folder-header-hash-internal folder)))
- (elmo-msgdb-create-overview-from-buffer number)))
+ (let ((header (elmo-get-hash-val
+ (elmo-map-message-location folder number)
+ (elmo-shimbun-folder-header-hash-internal folder))))
+ (when header
+ (with-temp-buffer
+ (shimbun-header-insert
+ (elmo-shimbun-folder-shimbun-internal folder)
+ header)
+ (elmo-msgdb-create-overview-from-buffer number)))))
(luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
numlist new-mark
(elmo-shimbun-folder-header-hash-internal folder)))
(buffer-string))))
+(luna-define-method elmo-folder-list-messages-internal :around
+ ((folder elmo-shimbun-folder) &optional nohide)
+ (if (elmo-folder-plugged-p folder)
+ (luna-call-next-method)
+ t))
+
(luna-define-method elmo-map-folder-list-message-locations
((folder elmo-shimbun-folder))
(mapcar
(function shimbun-header-id)
- (shimbun-headers (elmo-shimbun-folder-shimbun-internal folder))))
+ (elmo-shimbun-folder-headers-internal folder)))
(luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder)
&optional one-level)
(elmo-shimbun-folder-shimbun-internal folder))
"."
x))
- (shimbun-groups-internal (elmo-shimbun-folder-shimbun-internal folder)))))
+ (shimbun-groups (elmo-shimbun-folder-shimbun-internal folder)))))
(luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder))
(if (elmo-shimbun-folder-group-internal folder)
(progn
(member
(elmo-shimbun-folder-group-internal folder)
- (shimbun-groups-internal (elmo-shimbun-folder-shimbun-internal
- folder))))
+ (shimbun-groups (elmo-shimbun-folder-shimbun-internal
+ folder))))
t))
(luna-define-method elmo-folder-search ((folder elmo-shimbun-folder)
(luna-define-method elmo-folder-mark-as-read ((folder elmo-shimbun-folder)
numbers)
t)
-
+
+(luna-define-method elmo-quit ((folder elmo-shimbun-folder))
+ (setq elmo-shimbun-headers-cache nil))
+
(require 'product)
(product-provide (provide 'elmo-shimbun) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff