X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-shimbun.el;h=3e1c24bd8850e67352027ba3affe85e11cb12cb0;hb=12d00e8d6fa892f79091ebfc03d43b1cc0a877b0;hp=1e2bf02c97726fcf4c91e770c1ef15b6498b9308;hpb=3f1819b1be6f37f6a1564c1d8a81c2a7445f1f91;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index 1e2bf02..3e1c24b 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 @@ -89,9 +92,9 @@ update overview when message is fetched." (luna-define-internal-accessors 'shimbun-elmo-mua)) (luna-define-method shimbun-mua-search-id ((mua shimbun-elmo-mua) id) - (elmo-msgdb-overview-get-entity id - (elmo-folder-msgdb - (shimbun-elmo-mua-folder-internal mua)))) + (elmo-msgdb-message-entity (elmo-folder-msgdb + (shimbun-elmo-mua-folder-internal mua)) + id)) (eval-and-compile (luna-define-class elmo-shimbun-folder @@ -102,24 +105,23 @@ update overview when message is fetched." (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))) + (let ((overviews (elmo-folder-list-message-entities 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) + (elmo-set-hash-val (elmo-message-entity-field entity 'message-id) entity hash) - (when (setq id (elmo-msgdb-overview-entity-get-extra-field - entity "x-original-id")) + (when (setq id (elmo-message-entity-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))) + (let ((entity (elmo-msgdb-message-entity + (elmo-folder-msgdb folder) + location)) (elmo-hash-minimum-size 63) header) (when entity @@ -128,7 +130,8 @@ update overview when message is fetched." (elmo-shimbun-folder-set-header-hash-internal folder (setq hash (elmo-make-hash)))) - (elmo-set-hash-val (elmo-msgdb-overview-entity-get-id entity) + (elmo-set-hash-val (elmo-message-entity-field entity + 'message-id) header hash) header))))) @@ -155,29 +158,25 @@ update overview when message is fetched." (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) + (if (setq message-id (elmo-message-entity-field + entity 'x-original-id)) + (setq shimbun-id (elmo-message-entity-field entity 'message-id)) + (setq message-id (elmo-message-entity-field entity 'message-id) shimbun-id nil)) (elmo-set-work-buf (set-buffer-multibyte t) (shimbun-make-header - (elmo-msgdb-overview-entity-get-number entity) + (elmo-message-entity-number entity) (shimbun-mime-encode-string - (decode-mime-charset-string - (elmo-msgdb-overview-entity-get-subject-no-decode entity) - elmo-mime-charset)) + (elmo-message-entity-field entity 'subject 'decode)) (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) + (elmo-message-entity-field entity 'from 'decode)) + (elmo-message-entity-field entity 'date) message-id - (elmo-msgdb-overview-entity-get-references entity) + (elmo-message-entity-field entity 'references) 0 0 - (elmo-msgdb-overview-entity-get-extra-field entity "xref") + (elmo-message-entity-field entity 'xref) (and shimbun-id (list (cons "x-shimbun-id" shimbun-id))))))) @@ -190,8 +189,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. @@ -199,9 +198,9 @@ update overview when message is fetched." (delq nil (mapcar (lambda (x) - (unless (elmo-msgdb-overview-get-entity - (shimbun-header-id x) - (elmo-folder-msgdb folder)) + (unless (elmo-msgdb-message-entity + (elmo-folder-msgdb folder) + (shimbun-header-id x)) x)) ;; This takes much time. (shimbun-headers @@ -215,41 +214,47 @@ 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 + (condition-case nil + (shimbun-open (nth 0 server-group) + (luna-make-entity 'shimbun-elmo-mua :folder folder)) + (file-error + (luna-make-entity 'shimbun :server (nth 0 server-group)))))) + (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 +282,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 +324,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)) @@ -333,20 +340,18 @@ update overview when message is fetched." (shimbun-header-insert (elmo-shimbun-folder-shimbun-internal folder) header) - (setq ov (elmo-msgdb-create-overview-from-buffer number)) - (elmo-msgdb-overview-entity-set-extra + (setq ov (elmo-msgdb-create-message-entity-from-buffer + (elmo-msgdb-message-entity-handler + (elmo-folder-msgdb-internal folder)) number)) + (elmo-message-entity-set-field ov - (nconc - (elmo-msgdb-overview-entity-get-extra ov) - (list (cons "xref" (shimbun-header-xref header))))))))) + 'xref (shimbun-header-xref header))) + ov))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder) - numlist new-mark - already-mark seen-mark - important-mark - seen-list) - (let* (overview number-alist mark-alist entity - i percent number length pair msgid gmark seen) + numlist flag-table) + (let ((new-msgdb (elmo-make-msgdb)) + entity i percent length msgid flags) (setq length (length numlist)) (setq i 0) (message "Creating msgdb...") @@ -355,26 +360,10 @@ update overview when message is fetched." (elmo-shimbun-msgdb-create-entity folder (car numlist))) (when entity - (setq overview - (elmo-msgdb-append-element - overview entity)) - (setq number (elmo-msgdb-overview-entity-get-number entity)) - (setq msgid (elmo-msgdb-overview-entity-get-id entity)) - (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)))) - (setq mark-alist - (elmo-msgdb-mark-append mark-alist - number gmark)))) + (setq msgid (elmo-message-entity-field entity 'message-id) + flags (elmo-flag-table-get flag-table msgid)) + (elmo-global-flags-set flags folder (car numlist) msgid) + (elmo-msgdb-append-entity new-msgdb entity flags)) (when (> length elmo-display-progress-threshold) (setq i (1+ i)) (setq percent (/ (* i 100) length)) @@ -383,20 +372,19 @@ update overview when message is fetched." percent)) (setq numlist (cdr numlist))) (message "Creating msgdb...done") - (elmo-msgdb-sort-by-date - (list overview number-alist mark-alist)))) + (elmo-msgdb-sort-by-date new-msgdb))) (luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder)) nil) (defsubst elmo-shimbun-update-overview (folder shimbun-id header) - (let ((entity (elmo-msgdb-overview-get-entity shimbun-id - (elmo-folder-msgdb folder))) + (let ((entity (elmo-msgdb-message-entity (elmo-folder-msgdb folder) + shimbun-id)) (message-id (shimbun-header-id header)) references) (unless (string= shimbun-id message-id) - (elmo-msgdb-overview-entity-set-extra-field - entity "x-original-id" message-id) + (elmo-message-entity-set-field + entity 'x-original-id message-id) (elmo-shimbun-header-set-extra-field header "x-shimbun-id" shimbun-id) (elmo-set-hash-val message-id @@ -405,25 +393,31 @@ update overview when message is fetched." (elmo-set-hash-val shimbun-id entity (elmo-shimbun-folder-entity-hash folder))) - (elmo-msgdb-overview-entity-set-from + (elmo-message-entity-set-field entity + 'from (elmo-mime-string (shimbun-header-from header))) - (elmo-msgdb-overview-entity-set-subject + (elmo-message-entity-set-field entity + 'subject (elmo-mime-string (shimbun-header-subject header))) - (elmo-msgdb-overview-entity-set-date - entity (shimbun-header-date header)) + (elmo-message-entity-set-field + entity + 'date + (shimbun-header-date header)) (when (setq references (or (elmo-msgdb-get-last-message-id (elmo-field-body "in-reply-to")) (elmo-msgdb-get-last-message-id (elmo-field-body "references")))) - (elmo-msgdb-overview-entity-set-references + (elmo-message-entity-set-field entity - (or (elmo-msgdb-overview-entity-get-id + 'references + (or (elmo-message-entity-field (elmo-get-hash-val references - (elmo-shimbun-folder-entity-hash folder))) + (elmo-shimbun-folder-entity-hash folder)) + 'message-id) references))))) (luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder) @@ -471,17 +465,16 @@ update overview when message is fetched." (delq nil (mapcar (lambda (ov) - (when (and (elmo-msgdb-overview-entity-get-extra-field - ov "xref") + (when (and (elmo-message-entity-field ov 'xref) (if expire-days (< (elmo-shimbun-lapse-seconds (elmo-shimbun-parse-time-string - (elmo-msgdb-overview-entity-get-date ov))) + (elmo-message-entity-field ov 'date))) (* expire-days 86400 ; seconds per day )) t)) - (elmo-msgdb-overview-entity-get-id ov))) - (elmo-msgdb-get-overview (elmo-folder-msgdb folder)))) + (elmo-message-entity-field ov 'message-id))) + (elmo-folder-list-message-entities folder))) (mapcar (lambda (header) (or (elmo-shimbun-header-extra-field header "x-shimbun-id") @@ -490,15 +483,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 +524,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))