X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-shimbun.el;h=3f3b792fdf03c43d6571cc674cea3bdd61d08469;hb=fb40159a1fc3d4fb1400f8fe3befb1056bc75b8c;hp=1e2bf02c97726fcf4c91e770c1ef15b6498b9308;hpb=9ddac14c0b5daa5f6226bb422c36d16b2ccac5e9;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index 1e2bf02..3f3b792 100644 --- a/elmo/elmo-shimbun.el +++ b/elmo/elmo-shimbun.el @@ -33,6 +33,9 @@ (require 'elmo-dop) (require 'shimbun) +(eval-when-compile + (defun-maybe shimbun-servers-list ())) + (defcustom elmo-shimbun-check-interval 60 "*Check interval for shimbun." :type 'integer @@ -190,8 +193,8 @@ update overview when message is fetched." (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))) + (key (concat (shimbun-server shimbun) + "." (shimbun-current-group shimbun))) (elmo-hash-minimum-size 63) headers) ;; new headers. @@ -215,41 +218,44 @@ update overview when message is fetched." (luna-define-method elmo-folder-initialize ((folder elmo-shimbun-folder) name) - (let ((server-group (if (string-match "\\([^.]+\\)\\." name) - (list (elmo-match-string 1 name) - (substring name (match-end 0))) - (list name)))) - (when (nth 0 server-group) ; server - (elmo-shimbun-folder-set-shimbun-internal - folder - (shimbun-open (nth 0 server-group) - (luna-make-entity 'shimbun-elmo-mua :folder folder)))) - (when (nth 1 server-group) - (elmo-shimbun-folder-set-group-internal + (if (string= name "") + folder + (let ((server-group (if (string-match "\\([^.]+\\)\\." name) + (list (elmo-match-string 1 name) + (substring name (match-end 0))) + (list name)))) + (when (nth 0 server-group) ; server + (elmo-shimbun-folder-set-shimbun-internal + folder + (shimbun-open (nth 0 server-group) + (luna-make-entity 'shimbun-elmo-mua :folder folder)))) + (when (nth 1 server-group) + (elmo-shimbun-folder-set-group-internal + folder + (nth 1 server-group))) + (elmo-shimbun-folder-set-range-internal folder - (nth 1 server-group))) - (elmo-shimbun-folder-set-range-internal - folder - (or (cdr (elmo-string-matched-assoc (elmo-folder-name-internal folder) - elmo-shimbun-index-range-alist)) - elmo-shimbun-default-index-range)) - folder)) + (or (cdr (elmo-string-matched-assoc (elmo-folder-name-internal folder) + elmo-shimbun-index-range-alist)) + elmo-shimbun-default-index-range)) + folder))) (luna-define-method elmo-folder-open-internal ((folder elmo-shimbun-folder)) - (shimbun-open-group - (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 - 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))))) + (when (elmo-shimbun-folder-shimbun-internal folder) + (shimbun-open-group + (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 + 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) @@ -277,29 +283,31 @@ update overview when message is fetched." (luna-define-method elmo-folder-plugged-p ((folder elmo-shimbun-folder)) (elmo-plugged-p "shimbun" - (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder)) + (and (elmo-shimbun-folder-shimbun-internal folder) + (shimbun-server (elmo-shimbun-folder-shimbun-internal folder))) nil nil - (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder)))) + (and (elmo-shimbun-folder-shimbun-internal folder) + (shimbun-server (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 + (shimbun-server (elmo-shimbun-folder-shimbun-internal folder)) nil nil nil - (shimbun-server-internal + (shimbun-server (elmo-shimbun-folder-shimbun-internal folder)) add)) (luna-define-method elmo-net-port-info ((folder elmo-shimbun-folder)) (list "shimbun" - (shimbun-server-internal + (shimbun-server (elmo-shimbun-folder-shimbun-internal folder)) nil)) (luna-define-method elmo-folder-check :around ((folder elmo-shimbun-folder)) - (when (shimbun-current-group-internal + (when (shimbun-current-group (elmo-shimbun-folder-shimbun-internal folder)) (when (and (elmo-folder-plugged-p folder) (elmo-shimbun-headers-check-p folder)) @@ -317,7 +325,7 @@ update overview when message is fetched." (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-shimbun-folder)) (expand-file-name - (concat (shimbun-server-internal + (concat (shimbun-server (elmo-shimbun-folder-shimbun-internal folder)) "/" (elmo-shimbun-folder-group-internal folder)) @@ -341,10 +349,7 @@ update overview when message is fetched." (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 flag-table) (let* (overview number-alist mark-alist entity i percent number length pair msgid gmark seen) (setq length (length numlist)) @@ -363,15 +368,12 @@ update overview when message is fetched." (setq number-alist (elmo-msgdb-number-add number-alist number msgid)) - (setq seen (member msgid seen-list)) (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 - (if elmo-shimbun-use-cache - seen-mark) - new-mark)))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table msgid) + (elmo-file-cache-status + (elmo-file-cache-get msgid)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist number gmark)))) @@ -490,15 +492,37 @@ update overview when message is fetched." (luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder) &optional one-level) - (unless (elmo-shimbun-folder-group-internal folder) - (mapcar - (lambda (x) - (concat (elmo-folder-prefix-internal folder) - (shimbun-server-internal - (elmo-shimbun-folder-shimbun-internal folder)) - "." - x)) - (shimbun-groups (elmo-shimbun-folder-shimbun-internal folder))))) + (let ((prefix (elmo-folder-prefix-internal folder))) + (cond ((elmo-shimbun-folder-shimbun-internal folder) + (unless (elmo-shimbun-folder-group-internal folder) + (mapcar + (lambda (fld) + (concat prefix + (shimbun-server + (elmo-shimbun-folder-shimbun-internal folder)) + "." fld)) + (shimbun-groups (elmo-shimbun-folder-shimbun-internal folder))))) + ;; the rest are for "@/" group + (one-level + (mapcar + (lambda (server) (list (concat prefix server))) + (shimbun-servers-list))) + (t + (let (folders) + (dolist (server (shimbun-servers-list)) + (setq folders + (append folders + (mapcar + (lambda (fld) (concat prefix server "." fld)) + (shimbun-groups + (shimbun-open server + (let ((fld + (elmo-make-folder + (concat prefix server)))) + (luna-make-entity + 'shimbun-elmo-mua + :folder fld)))))))) + folders))))) (luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder)) (if (elmo-shimbun-folder-group-internal folder) @@ -509,27 +533,6 @@ update overview when message is fetched." folder)))) t)) -;;; 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))