* wl-mime.el (toplevel): Require wl-vars.
[elisp/wanderlust.git] / elmo / elmo-shimbun.el
index cecef52..982e3c7 100644 (file)
@@ -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-overview-get-entity id
-                                 (elmo-folder-msgdb
-                                  (shimbun-elmo-mua-folder-internal mua))))
+  (elmo-message-entity (shimbun-elmo-mua-folder-internal mua) id))
 
 (eval-and-compile
   (luna-define-class elmo-shimbun-folder
@@ -105,24 +106,21 @@ 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-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-overview-get-entity
-                           (shimbun-header-id x)
-                           (elmo-folder-msgdb folder))
+                  (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 gmark)
+       entity i percent length msgid flags)
     (setq length (length numlist))
     (setq i 0)
     (message "Creating msgdb...")
@@ -360,14 +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))
-       (setq gmark (or (elmo-msgdb-global-mark-get msgid)
-                       (elmo-msgdb-mark
-                        (elmo-flag-table-get flag-table msgid)
-                        (elmo-file-cache-status
-                         (elmo-file-cache-get msgid))
-                        'new)))
-       (elmo-msgdb-append-entity new-msgdb entity 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))
@@ -382,13 +375,12 @@ update overview when message is fetched."
   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-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
@@ -397,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)
@@ -428,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"))
@@ -463,17 +462,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")
@@ -523,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))