X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-shimbun.el;h=982e3c7fb69c97ec3c11e7ce16907677b1b98d9a;hb=4dee2f09b7c63b19e24942f13b2917addb2a6501;hp=08415f77ca5be8051d887fdc41335dae2e0408e4;hpb=f4aed41040236d1fc835dd7bc475a2d8c3e611ec;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index 08415f7..982e3c7 100644 --- a/elmo/elmo-shimbun.el +++ b/elmo/elmo-shimbun.el @@ -34,6 +34,7 @@ (require 'shimbun) (eval-when-compile + (require 'cl) (defun-maybe shimbun-servers-list ())) (defcustom elmo-shimbun-check-interval 60 @@ -64,11 +65,13 @@ See `shimbun-headers' for more detail about RANGE." (integer :tag "number")))) :group 'elmo) -(defcustom elmo-shimbun-update-overview-folder-list nil +(defcustom elmo-shimbun-update-overview-folder-list 'all "*List of FOLDER-REGEXP. FOLDER-REGEXP is the regexp of shimbun folder name which should be -update overview when message is fetched." - :type '(repeat (regexp :tag "Folder Regexp")) +update overview when message is fetched. +If it is the symbol `all', update overview for all shimbun folders." + :type '(choice (const :tag "All shimbun folders" all) + (repeat (regexp :tag "Folder Regexp"))) :group 'elmo) ;; Shimbun header. @@ -92,9 +95,7 @@ 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-message-entity (elmo-folder-msgdb - (shimbun-elmo-mua-folder-internal mua)) - id)) + (elmo-message-entity (shimbun-elmo-mua-folder-internal mua) id)) (eval-and-compile (luna-define-class elmo-shimbun-folder @@ -110,19 +111,16 @@ update overview when message is fetched." (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-message-entity - (elmo-folder-msgdb folder) - location)) + (let ((entity (elmo-message-entity folder location)) (elmo-hash-minimum-size 63) header) (when entity @@ -131,7 +129,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))))) @@ -158,29 +157,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))))))) @@ -202,9 +197,7 @@ update overview when message is fetched." (delq nil (mapcar (lambda (x) - (unless (elmo-msgdb-message-entity - (elmo-folder-msgdb folder) - (shimbun-header-id x)) + (unless (elmo-message-entity folder (shimbun-header-id x)) x)) ;; This takes much time. (shimbun-headers @@ -227,8 +220,11 @@ update overview when message is fetched." (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)))) + (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 @@ -281,13 +277,13 @@ update overview when message is fetched." folder nil)) (luna-define-method elmo-folder-plugged-p ((folder elmo-shimbun-folder)) - (elmo-plugged-p - "shimbun" - (and (elmo-shimbun-folder-shimbun-internal folder) - (shimbun-server (elmo-shimbun-folder-shimbun-internal folder))) - nil nil - (and (elmo-shimbun-folder-shimbun-internal folder) - (shimbun-server (elmo-shimbun-folder-shimbun-internal folder))))) + (if (elmo-shimbun-folder-shimbun-internal folder) + (elmo-plugged-p + "shimbun" + (shimbun-server (elmo-shimbun-folder-shimbun-internal folder)) + nil nil + (shimbun-server (elmo-shimbun-folder-shimbun-internal folder))) + t)) (luna-define-method elmo-folder-set-plugged ((folder elmo-shimbun-folder) plugged &optional add) @@ -341,17 +337,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 flag-table) (let ((new-msgdb (elmo-make-msgdb)) - entity i percent length msgid) + entity i percent length msgid flags) (setq length (length numlist)) (setq i 0) (message "Creating msgdb...") @@ -360,9 +357,10 @@ update overview when message is fetched." (elmo-shimbun-msgdb-create-entity folder (car numlist))) (when entity - (setq msgid (elmo-msgdb-overview-entity-get-id entity)) - (elmo-msgdb-append-entity new-msgdb entity - (elmo-flag-table-get flag-table msgid))) + (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)) @@ -377,13 +375,12 @@ update overview when message is fetched." nil) (defsubst elmo-shimbun-update-overview (folder shimbun-id header) - (let ((entity (elmo-msgdb-message-entity (elmo-folder-msgdb folder) - shimbun-id)) + (let ((entity (elmo-message-entity 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 @@ -392,25 +389,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) @@ -423,9 +426,10 @@ update overview when message is fetched." shimbun-id) (shimbun-article (elmo-shimbun-folder-shimbun-internal folder) header) - (when (elmo-string-match-member - (elmo-folder-name-internal folder) - elmo-shimbun-update-overview-folder-list) + (when (or (eq elmo-shimbun-update-overview-folder-list 'all) + (elmo-string-match-member + (elmo-folder-name-internal folder) + elmo-shimbun-update-overview-folder-list)) (elmo-shimbun-update-overview folder location header)) (when (setq shimbun-id (elmo-shimbun-header-extra-field header "x-shimbun-id")) @@ -458,16 +462,15 @@ 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-message-entity-field ov 'message-id))) (elmo-folder-list-message-entities folder))) (mapcar (lambda (header) @@ -518,6 +521,11 @@ update overview when message is fetched." folder)))) t)) +(luna-define-method elmo-folder-delete-messages ((folder elmo-shimbun-folder) + numbers) + (elmo-folder-kill-messages folder numbers) + t) + (require 'product) (product-provide (provide 'elmo-shimbun) (require 'elmo-version))