From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 23 Oct 1996 22:14:22 +0000 (+0000)
Subject: When reading in context headers, mark them as ignored when necessary.
X-Git-Tag: 20090517-FFI~5343
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6546c42697c0950b7dda1ddebed83e99175a7949;p=mit-scheme.git

When reading in context headers, mark them as ignored when necessary.
Also, delete entire threads of "seen" context headers.
---

diff --git a/v7/src/edwin/snr.scm b/v7/src/edwin/snr.scm
index c4d0ec3a7..1fe7ca067 100644
--- a/v7/src/edwin/snr.scm
+++ b/v7/src/edwin/snr.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: snr.scm,v 1.14 1996/10/15 19:04:59 cph Exp $
+;;;	$Id: snr.scm,v 1.15 1996/10/23 22:14:22 cph Exp $
 ;;;
 ;;;	Copyright (c) 1995-96 Massachusetts Institute of Technology
 ;;;
@@ -3579,16 +3579,16 @@ With prefix arg, replaces the file with the list information."
   (let ((headers (news-group:get-headers group argument buffer))
 	(msg "Threading headers... "))
     (message msg)
-    (let ((value
-	   (list->vector
-	    (organize-headers-into-threads
-	     headers
-	     (ref-variable news-group-show-context-headers buffer)
-	     #f
-	     (ref-variable news-split-threads-on-subject-changes buffer)
-	     (ref-variable news-join-threads-with-same-subject buffer)))))
+    (let ((threads
+	   (organize-headers-into-threads
+	    headers
+	    (ref-variable news-group-show-context-headers buffer)
+	    #f
+	    (ref-variable news-split-threads-on-subject-changes buffer)
+	    (ref-variable news-join-threads-with-same-subject buffer))))
       (message msg "done")
-      value)))
+      (list->vector
+       (list-transform-negative threads news-thread:all-articles-seen?)))))
 
 (define (news-group:get-headers group argument buffer)
   (let ((connection (news-group:connection group))
@@ -3625,7 +3625,7 @@ With prefix arg, replaces the file with the list information."
 		  (let ((t (get-universal-time))
 			(show-ignored? (not all?)))
 		    (lambda (header)
-		      (and (news-header:ignore? header table t)
+		      (and (news-header:ignore?! header table t)
 			   (begin
 			     (set-news-header:status! header #\I)
 			     (article-number-seen! group
@@ -3756,7 +3756,7 @@ With prefix arg, replaces the file with the list information."
 
 ;;;; Ignored-Subjects Database
 
-(define (news-header:ignore? header table t)
+(define (news-header:ignore?! header table t)
   (let ((subject (canonicalize-subject (news-header:subject header))))
     (and (not (fix:= 0 (string-length subject)))
 	 (hash-table/get table subject #f)
@@ -3771,6 +3771,14 @@ With prefix arg, replaces the file with the list information."
 	       (news-group:ignored-subjects-modified! group)))
 	   #t))))
 
+(define (news-header:ignore? header)
+  (let ((table
+	 (news-group:get-ignored-subjects (news-header:group header) #f)))
+    (and table
+	 (hash-table/get table
+			 (canonicalize-subject (news-header:subject header))
+			 #f))))
+
 (define (news-group:article-ignored! group header buffer)
   (let ((subject (canonicalize-subject (news-header:subject header))))
     (if (not (fix:= 0 (string-length subject)))
@@ -4020,19 +4028,21 @@ With prefix arg, replaces the file with the list information."
 
 (define (get-news-header-extra header write?)
   (or (news-header:reader-hook header)
-      (let ((extra
-	     (make-news-header-extra
-	      (if (or (not (news-header:real? header))
-		      (let ((number (news-header:number header)))
-			(or (not number)
-			    (member-of-ranges? (news-group:ranges-seen
-						(news-header:group header))
-					       number))))
-		  #\D
-		  #\space))))
+      (let ((extra (make-news-header-extra (initial-header-status header))))
 	(if write? (set-news-header:reader-hook! header extra))
 	extra)))
 
+(define (initial-header-status header)
+  (cond ((or (not (news-header:real? header))
+	     (not (news-header:number header)))
+	 #\D)
+	((member-of-ranges? (news-group:ranges-seen
+			     (news-header:group header))
+			    (news-header:number header))
+	 (if (news-header:ignore? header) #\I #\D))
+	(else
+	 #\space)))
+
 (define (news-header:status header)
   (news-header-extra:status (get-news-header-extra header #f)))