X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnshimbun.el;h=2d3faa5ebebe05970aecef4359b0df8cf0c02c07;hb=0563df167689ba46e219f7915c6f5b321da614ce;hp=2c84ac2eff082a8477b0779a7722953a18603edf;hpb=e5bec5d05f433a43fa2d14cdb7bebeeefab8835f;p=elisp%2Fgnus.git-

diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el
index 2c84ac2..2d3faa5 100644
--- a/lisp/nnshimbun.el
+++ b/lisp/nnshimbun.el
@@ -97,7 +97,8 @@
 ;;; backlog
 (defmacro nnshimbun-backlog (&rest form)
   `(let ((gnus-keep-backlog nnshimbun-keep-backlog)
-	 (gnus-backlog-buffer (format " *nnshimbun backlog %s*" (nnoo-current-server 'nnshimbun)))
+	 (gnus-backlog-buffer (format " *nnshimbun backlog %s*"
+				      (nnoo-current-server 'nnshimbun)))
 	 (gnus-backlog-articles nnshimbun-backlog-articles)
 	 (gnus-backlog-hashtb nnshimbun-backlog-hashtb))
      (unwind-protect
@@ -115,7 +116,8 @@
   (push (list 'nnshimbun-shimbun
 	      (condition-case err
 		  (shimbun-open server (luna-make-entity 'shimbun-gnus-mua))
-		(error (nnheader-report 'nnshimbun "%s" (error-message-string err)))))
+		(error (nnheader-report 'nnshimbun "%s" (error-message-string
+							 err)))))
 	defs)
   ;; Set directory for server working files.
   (push (list 'nnshimbun-server-directory
@@ -130,7 +132,8 @@
   (cond
    ((not (file-exists-p nnshimbun-directory))
     (nnshimbun-close-server)
-    (nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-directory))
+    (nnheader-report 'nnshimbun "Couldn't create directory: %s"
+		     nnshimbun-directory))
    ((not (file-directory-p (file-truename nnshimbun-directory)))
     (nnshimbun-close-server)
     (nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-directory))
@@ -140,10 +143,12 @@
     (cond
      ((not (file-exists-p nnshimbun-server-directory))
       (nnshimbun-close-server)
-      (nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-server-directory))
+      (nnheader-report 'nnshimbun "Couldn't create directory: %s"
+		       nnshimbun-server-directory))
      ((not (file-directory-p (file-truename nnshimbun-server-directory)))
       (nnshimbun-close-server)
-      (nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-server-directory))
+      (nnheader-report 'nnshimbun "Not a directory: %s"
+		       nnshimbun-server-directory))
      (t
       (nnheader-report 'nnshimbun "Opened server %s using directory %s"
 		       server nnshimbun-server-directory)
@@ -195,6 +200,9 @@
 	 (substring xref 6)
        xref))))
 
+(eval-when-compile
+  (require 'gnus-sum));; For the macro `gnus-summary-article-header'.
+
 (defun nnshimbun-request-article-1 (article &optional group server to-buffer)
   (if (nnshimbun-backlog
 	(gnus-backlog-request-article
@@ -209,6 +217,10 @@
 	(with-current-buffer (or to-buffer nntp-server-buffer)
 	  (delete-region (point-min) (point-max))
 	  (shimbun-article nnshimbun-shimbun header)
+	  ;; Kludge! replace a date string in `gnus-newsgroup-data'
+	  ;; based on the newly retrieved article.
+	  (mail-header-set-date (gnus-summary-article-header article)
+				(shimbun-header-date header))
 	  (when (> (buffer-size) 0)
 	    (nnshimbun-replace-nov-entry group article header original-id)
 	    (nnshimbun-backlog
@@ -304,7 +316,8 @@
 (defun nnshimbun-retrieve-headers-with-nov (articles &optional fetch-old)
   (if (or gnus-nov-is-evil nnshimbun-nov-is-evil)
       nil
-    (let ((nov (expand-file-name nnshimbun-nov-file-name nnshimbun-current-directory)))
+    (let ((nov (expand-file-name nnshimbun-nov-file-name
+				 nnshimbun-current-directory)))
       (when (file-exists-p nov)
 	(save-excursion
 	  (set-buffer nntp-server-buffer)
@@ -498,13 +511,16 @@ However, the optional FORCE if it is non-nil (it is supposed to be
 specified by the command `nnshimbun-expire-nov-databases'), it does
 expire for the SERVER:GROUP even if whose NOV is not open."
   (let ((buffer (cdr (assoc group nnshimbun-nov-buffer-alist)))
+	(nnmail-expiry-wait-function nnmail-expiry-wait-function)
+	(nnmail-expiry-wait nnmail-expiry-wait)
 	(progress-msg (format "Expiring NOV database for nnshimbun+%s:%s "
 			      server group))
 	(pinwheel "-/|\\")
 	(counter 0)
-	should-close-nov name article expirable end time)
+	name should-close-nov article expirable end time)
     (if (and
 	 server
+	 (setq name (concat "nnshimbun+" server ":" group))
 	 (or (let ((current (nnoo-current-server 'nnshimbun)))
 	       (and current
 		    (string-equal server current)
@@ -514,6 +530,12 @@ expire for the SERVER:GROUP even if whose NOV is not open."
 		     buffer (gnus-get-buffer-create
 			     (format " *nnshimbun overview %s %s*"
 				     server group)))
+	       (let ((expiry-wait (gnus-group-find-parameter name
+							     'expiry-wait)))
+		 (when expiry-wait
+		   ;; Prefer the group parameter `expiry-wait'.
+		   (setq nnmail-expiry-wait-function nil
+			 nnmail-expiry-wait expiry-wait)))
 	       (save-excursion
 		 (set-buffer buffer)
 		 (set (make-local-variable 'nnshimbun-nov-buffer-file-name)
@@ -531,7 +553,6 @@ expire for the SERVER:GROUP even if whose NOV is not open."
 	       t)))
 	(prog1
 	    (save-excursion
-	      (setq name (concat "nnshimbun+" server ":" group))
 	      (set-buffer buffer)
 	      (when (eq 'all articles)
 		(setq articles nil)
@@ -663,9 +684,11 @@ nil)."
 	(ignore-errors (make-directory nnshimbun-current-directory t)))
       (cond
        ((not (file-exists-p nnshimbun-current-directory))
-	(nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-current-directory))
+	(nnheader-report 'nnshimbun "Couldn't create directory: %s"
+			 nnshimbun-current-directory))
        ((not (file-directory-p (file-truename nnshimbun-current-directory)))
-	(nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-current-directory))
+	(nnheader-report 'nnshimbun "Not a directory: %s"
+			 nnshimbun-current-directory))
        (t t)))))