X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-shimbun.el;h=3f3b792fdf03c43d6571cc674cea3bdd61d08469;hb=a5bcb1f0eb41b558a6b4ed277047adc6b8676a2a;hp=d47230b152e305f1ec697d2d0461248e09261580;hpb=198256de9ef909630efb1500022cfd0b89136abf;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index d47230b..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,9 +193,9 @@ 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))) - (elmo-hash-minimum-size 0) + (key (concat (shimbun-server shimbun) + "." (shimbun-current-group shimbun))) + (elmo-hash-minimum-size 63) headers) ;; new headers. (setq 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)))) @@ -382,7 +384,7 @@ update overview when message is fetched." 'elmo-folder-msgdb-create "Creating msgdb..." percent)) (setq numlist (cdr numlist))) - (message "Creating msgdb...done.") + (message "Creating msgdb...done") (elmo-msgdb-sort-by-date (list overview number-alist mark-alist)))) @@ -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))