From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 23 Oct 1996 22:59:36 +0000 (+0000)
Subject: Change code that joins and splits threads on the basis of subject.
X-Git-Tag: 20090517-FFI~5341
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6d686b5d0a25f11eb97f636f98a2bd392c174f9c;p=mit-scheme.git

Change code that joins and splits threads on the basis of subject.
This code is now more discriminating than previously.
---

diff --git a/v7/src/edwin/nntp.scm b/v7/src/edwin/nntp.scm
index f07bf4cfc..655fac4ea 100644
--- a/v7/src/edwin/nntp.scm
+++ b/v7/src/edwin/nntp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: nntp.scm,v 1.9 1996/10/15 20:19:20 cph Exp $
+;;;	$Id: nntp.scm,v 1.10 1996/10/23 22:59:36 cph Exp $
 ;;;
 ;;;	Copyright (c) 1995-96 Massachusetts Institute of Technology
 ;;;
@@ -1563,9 +1563,11 @@
 			    (if (news-header:real? parent)
 				(news-header:subject parent)
 				(find-tree-subject header))))
-		       (compare-subjects
-			(canonicalize-subject (news-header:subject header))
-			(canonicalize-subject subject)))))
+		       (memq
+			(compare-subjects
+			 (canonicalize-subject (news-header:subject header))
+			 (canonicalize-subject subject))
+			'(EQUAL LEFT-PREFIX)))))
 	       (disassociate-header-from-parent header parent)))))
    headers))
 
@@ -1652,13 +1654,9 @@
 (define (assoc-subject subject alist)
   (let loop ((alist alist))
     (and (not (null? alist))
-	 (let ((comparison (compare-subjects subject (caar alist))))
-	   (if comparison
-	       (begin
-		 (if (eq? 'LEFT-PREFIX comparison)
-		     (set-car! (car alist) subject))
-		 (car alist))
-	       (loop (cdr alist)))))))
+	 (if (eq? 'EQUAL (compare-subjects subject (caar alist)))
+	     (car alist)
+	     (loop (cdr alist))))))
 
 (define (compare-subjects x y)
   (let ((xe (string-length x))