From: hmurata Date: Sat, 10 Nov 2001 13:31:09 +0000 (+0000) Subject: * elmo-shimbun.el (elmo-shimbun-update-overview-folder-list): New X-Git-Tag: wl-2_8-root~152 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=2b26b64edb6a8ec2027d61da09b555b13f278308;p=elisp%2Fwanderlust.git * 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. --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 5dcfa34..00675bb 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,25 @@ +2001-11-10 Hiroya Murata + + * 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 * mmimap.el (mmimap-entity-section): Changed body node number from diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index deb8422..9c4217d 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -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))) diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index 707f317..4011a31 100644 --- a/elmo/elmo-shimbun.el +++ b/elmo/elmo-shimbun.el @@ -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)