* elmo-shimbun.el (elmo-shimbun-update-overview-folder-list): New
authorhmurata <hmurata>
Sat, 10 Nov 2001 13:31:09 +0000 (13:31 +0000)
committerhmurata <hmurata>
Sat, 10 Nov 2001 13:31:09 +0000 (13:31 +0000)
user option.
(elmo-shimbun-header-extra-field): New inline function.
(elmo-shimbun-header-set-extra-field): Ditto.
(elmo-shimbun-folder-header-hash-setup): Ditto.
(elmo-shimbun-update-overview): Ditto.
(elmo-shimbun-msgdb-to-headers): Set extra field `x-shimbun-id'.
(elmo-shimbun-folder-setup): Use
`elmo-shimbun-folder-header-hash-setup' to be setup hash table.
(elmo-shimbun-get-headers): Ditto.
(elmo-map-message-fetch): Call `elmo-shimbun-update-overview';
Insert `X-Shimbun-Id:' header if extra field is set.
(elmo-map-folder-list-message-locations): Return `x-shimbun-id'
field's value instead of `shimbun-header-id'.

* elmo-msgdb.el (elmo-msgdb-overview-entity-set-references): New
inline function.
(elmo-msgdb-overview-entity-set-date): Ditto.
(elmo-msgdb-overview-entity-set-extra-field): Ditto.

elmo/ChangeLog
elmo/elmo-msgdb.el
elmo/elmo-shimbun.el

index 5dcfa34..00675bb 100644 (file)
@@ -1,3 +1,25 @@
+2001-11-10  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
+
+       * elmo-shimbun.el (elmo-shimbun-update-overview-folder-list): New
+       user option.
+       (elmo-shimbun-header-extra-field): New inline function.
+       (elmo-shimbun-header-set-extra-field): Ditto.
+       (elmo-shimbun-folder-header-hash-setup): Ditto.
+       (elmo-shimbun-update-overview): Ditto.
+       (elmo-shimbun-msgdb-to-headers): Set extra field `x-shimbun-id'.
+       (elmo-shimbun-folder-setup): Use
+       `elmo-shimbun-folder-header-hash-setup' to be setup hash table.
+       (elmo-shimbun-get-headers): Ditto.
+       (elmo-map-message-fetch): Call `elmo-shimbun-update-overview';
+       Insert `X-Shimbun-Id:' header if extra field is set.
+       (elmo-map-folder-list-message-locations): Return `x-shimbun-id'
+       field's value instead of `shimbun-header-id'.
+
+       * elmo-msgdb.el (elmo-msgdb-overview-entity-set-references): New
+       inline function.
+       (elmo-msgdb-overview-entity-set-date): Ditto.
+       (elmo-msgdb-overview-entity-set-extra-field): Ditto.
+
 2001-11-09  Yuuichi Teranishi  <teranisi@gohome.org>
 
        * mmimap.el (mmimap-entity-section): Changed body node number from
index deb8422..9c4217d 100644 (file)
@@ -383,12 +383,16 @@ content of MSGDB is changed."
 (defsubst elmo-msgdb-overview-entity-get-references (entity)
   (and entity (aref (cdr entity) 1)))
 
+(defsubst elmo-msgdb-overview-entity-set-references (entity references)
+  (and entity (aset (cdr entity) 1 references))
+  entity)
+
 ;; entity -> parent-entity
 (defsubst elmo-msgdb-overview-get-parent-entity (entity database)
   (setq entity (elmo-msgdb-overview-entity-get-references entity))
   ;; entity is parent-id.
   (and entity (assoc entity database)))
-  
+
 (defsubst elmo-msgdb-overview-entity-get-number (entity)
   (and entity (aref (cdr entity) 0)))
 
@@ -424,6 +428,10 @@ content of MSGDB is changed."
 (defsubst elmo-msgdb-overview-entity-get-date (entity)
   (and entity (aref (cdr entity) 4)))
 
+(defsubst elmo-msgdb-overview-entity-set-date (entity date)
+  (and entity (aset (cdr entity) 4 date))
+  entity)
+
 (defsubst elmo-msgdb-overview-entity-get-to (entity)
   (and entity (aref (cdr entity) 5)))
 
@@ -445,6 +453,15 @@ content of MSGDB is changed."
     (and extra
         (cdr (assoc field-name extra)))))
 
+(defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
+  (let ((extras (and entity (aref (cdr entity) 8)))
+       extra)
+    (if (setq extra (assoc field-name extras))
+       (setcdr extra value)
+      (elmo-msgdb-overview-entity-set-extra
+       entity
+       (cons (cons field-name value) extras)))))
+
 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
   (and entity (aref (cdr entity) 8)))
 
index 707f317..4011a31 100644 (file)
@@ -61,6 +61,28 @@ See `shimbun-headers' for more detail about RANGE."
                               (integer :tag "number"))))
   :group 'elmo)
 
+(defcustom elmo-shimbun-update-overview-folder-list nil
+  "*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"))
+  :group 'elmo)
+
+;; Shimbun header.
+(defsubst elmo-shimbun-header-extra-field (header field-name)
+  (let ((extra (and header (shimbun-header-extra header))))
+    (and extra
+        (cdr (assoc field-name extra)))))
+
+(defsubst elmo-shimbun-header-set-extra-field (header field-name value)
+  (let ((extras (and header (shimbun-header-extra header)))
+       extra)
+    (if (setq extra (assoc field-name extras))
+       (setcdr extra value)
+      (shimbun-header-set-extra
+       header
+       (cons (cons field-name value) extras)))))
+
 ;; Shimbun mua.
 (eval-and-compile
   (luna-define-class shimbun-elmo-mua (shimbun-mua) (folder))
@@ -98,7 +120,7 @@ See `shimbun-headers' for more detail about RANGE."
              elmo-shimbun-check-interval))))
 
 (defun elmo-shimbun-msgdb-to-headers (folder expire-days)
-  (let (headers)
+  (let (headers message-id shimbun-id)
     (dolist (ov (elmo-msgdb-get-overview (elmo-folder-msgdb folder)))
       (when (and (elmo-msgdb-overview-entity-get-extra-field ov "xref")
                 (if expire-days
@@ -108,6 +130,11 @@ See `shimbun-headers' for more detail about RANGE."
                        (* expire-days 86400 ; seconds per day
                           ))
                   t))
+       (if (setq message-id (elmo-msgdb-overview-entity-get-extra-field
+                             ov "x-original-id"))
+           (setq shimbun-id (elmo-msgdb-overview-entity-get-id ov))
+         (setq message-id (elmo-msgdb-overview-entity-get-id ov)
+               shimbun-id nil))
        (setq headers
              (cons (shimbun-make-header
                     (elmo-msgdb-overview-entity-get-number ov)
@@ -116,27 +143,34 @@ See `shimbun-headers' for more detail about RANGE."
                     (shimbun-mime-encode-string
                      (elmo-msgdb-overview-entity-get-from ov))
                     (elmo-msgdb-overview-entity-get-date ov)
-                    (elmo-msgdb-overview-entity-get-id ov)
+                    message-id
                     (elmo-msgdb-overview-entity-get-references ov)
                     0
                     0
-                    (elmo-msgdb-overview-entity-get-extra-field ov "xref"))
+                    (elmo-msgdb-overview-entity-get-extra-field ov "xref")
+                    (and shimbun-id
+                         (list (cons "x-shimbun-id" shimbun-id))))
                    headers))))
     (nreverse headers)))
 
+(defsubst elmo-shimbun-folder-header-hash-setup (folder headers)
+  (let ((hash (elmo-make-hash (length headers)))
+       shimbun-id)
+    (dolist (header headers)
+      (elmo-set-hash-val (shimbun-header-id header) header hash)
+      (when (setq shimbun-id
+                 (elmo-shimbun-header-extra-field header "x-shimbun-id"))
+       (elmo-set-hash-val shimbun-id header hash)))
+    (elmo-shimbun-folder-set-header-hash-internal folder hash)))
+
 (defun elmo-shimbun-folder-setup (folder)
   ;; Resume headers from existing msgdb.
   (elmo-shimbun-folder-set-headers-internal
    folder
    (elmo-shimbun-msgdb-to-headers folder nil))
-  (elmo-shimbun-folder-set-header-hash-internal
+  (elmo-shimbun-folder-header-hash-setup
    folder
-   (elmo-make-hash
-    (length (elmo-shimbun-folder-headers-internal folder))))
-  (dolist (header (elmo-shimbun-folder-headers-internal folder))
-    (elmo-set-hash-val
-     (shimbun-header-id header) header
-     (elmo-shimbun-folder-header-hash-internal folder))))
+   (elmo-shimbun-folder-headers-internal folder)))
 
 (defun elmo-shimbun-get-headers (folder)
   (let* ((shimbun (elmo-shimbun-folder-shimbun-internal folder))
@@ -163,16 +197,9 @@ See `shimbun-headers' for more detail about RANGE."
             folder (shimbun-article-expiration-days
                     (elmo-shimbun-folder-shimbun-internal folder)))
            headers))
-    (setq hash
-         (elmo-shimbun-folder-set-header-hash-internal
+    (elmo-shimbun-folder-header-hash-setup
           folder
-          (elmo-make-hash
-           (length (elmo-shimbun-folder-headers-internal folder)))))
-    ;; Set up header hash.
-    (dolist (header (elmo-shimbun-folder-headers-internal folder))
-      (elmo-set-hash-val
-       (shimbun-header-id header) header
-       (elmo-shimbun-folder-header-hash-internal folder)))
+     (elmo-shimbun-folder-headers-internal folder))
     (elmo-shimbun-folder-set-last-check-internal folder (current-time))))
 
 (luna-define-method elmo-folder-initialize ((folder
@@ -349,14 +376,59 @@ See `shimbun-headers' for more detail about RANGE."
 (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)))
+       (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-shimbun-header-set-extra-field
+       header "x-shimbun-id" shimbun-id)
+      (elmo-set-hash-val message-id
+                        header
+                        (elmo-shimbun-folder-header-hash-internal folder)))
+    (elmo-msgdb-overview-entity-set-from
+     entity
+     (elmo-mime-string (shimbun-header-from header)))
+    (elmo-msgdb-overview-entity-set-subject
+     entity
+     (elmo-mime-string (shimbun-header-subject header)))
+    (elmo-msgdb-overview-entity-set-date
+     entity (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
+       entity
+       (or (elmo-shimbun-header-extra-field
+           (elmo-get-hash-val references
+                              (elmo-shimbun-folder-header-hash-internal
+                               folder))
+           "x-shimbun-id")
+          references)))))
+
 (luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder)
                                            location strategy
                                            &optional section unseen)
   (if (elmo-folder-plugged-p folder)
-      (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
-                      (elmo-get-hash-val
-                       location
-                       (elmo-shimbun-folder-header-hash-internal folder)))
+      (let ((header (elmo-get-hash-val
+                    location
+                    (elmo-shimbun-folder-header-hash-internal folder)))
+           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)
+         (elmo-shimbun-update-overview folder location header))
+       (when (setq shimbun-id
+                   (elmo-shimbun-header-extra-field header "x-shimbun-id"))
+         (goto-char (point-min))
+         (insert (format "X-Shimbun-Id: %s\n" shimbun-id))))
     (error "Unplugged")))
 
 (luna-define-method elmo-message-encache :around ((folder
@@ -377,7 +449,9 @@ See `shimbun-headers' for more detail about RANGE."
 (luna-define-method elmo-map-folder-list-message-locations
   ((folder elmo-shimbun-folder))
   (mapcar
-   (function shimbun-header-id)
+   (lambda (header)
+     (or (elmo-shimbun-header-extra-field header "x-shimbun-id")
+        (shimbun-header-id header)))
    (elmo-shimbun-folder-headers-internal folder)))
 
 (luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder)