From 6d686b5d0a25f11eb97f636f98a2bd392c174f9c Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 23 Oct 1996 22:59:36 +0000 Subject: [PATCH] Change code that joins and splits threads on the basis of subject. This code is now more discriminating than previously. --- v7/src/edwin/nntp.scm | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) 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)) -- 2.25.1