* Change terminology to refer to "seen" articles as "deleted".

* Introduce new marking, "browsed", to indicate articles whose headers
  have been shown in a news-group buffer.  These "browsed" markings
  are used to prevent a common problem with cross posts: after having
  marked an article in one group, re-marking the cross-posted article
  differently in another group clobbers the original markings.  The
  news reader now examines the "browsed" marking, and does not re-mark
  any cross post that has already been "browsed".

* Change code that selects initial header when opening a news-group
  buffer for the first time.  New code does not automatically expand a
  thread whose first message is "deleted".

diff --git a/v7/src/edwin/snr.scm b/v7/src/edwin/snr.scm
index 25d4cc03da46835a9e1065caef239129e4d527b2..3ebf592c5e42d4dcadea706069309a484f7e26c2 100644 (file)
--- a/v7/src/edwin/snr.scm
+++ b/v7/src/edwin/snr.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: snr.scm,v 1.24 1996/12/24 08:50:32 cph Exp $
+;;;    $Id: snr.scm,v 1.25 1996/12/25 06:50:07 cph Exp $
 ;;;
 ;;;    Copyright (c) 1995-96 Massachusetts Institute of Technology
 ;;;
@@ -822,7 +822,7 @@ With prefix argument, clears the list for the next several News groups."
   (lambda (argument)
     (group-iteration argument
       (lambda (buffer group)
-       (set-news-group:ranges-seen! group '())
+       (set-news-group:ranges-deleted! group '())
        (update-news-groups-buffers buffer group)))))
 \f
 (define-command news-subscribe-group
@@ -1065,7 +1065,7 @@ This shows News groups that have been created since the last time that
     (and name
         (let ((connection (buffer-nntp-connection (mark-buffer mark))))
           (or (find-news-group connection name)
-              (make-news-group-1 connection name #f #f '() '()))))))
+              (make-news-group-1 connection name #f #f '() '() '()))))))
 
 (define (ang-buffer:mark-group-name mark)
   (and (re-match-forward
@@ -1092,12 +1092,16 @@ This shows News groups that have been created since the last time that
       (let ((ls (find-first-property-line buffer 'NEWS-HEADER #f)))
        (and ls
             (let ((header (region-get ls 'NEWS-HEADER #f)))
-              (cond ((not (news-header:article-seen? header)) ls)
+              (cond ((not (news-header:article-deleted? header)) ls)
                     ((news-group-buffer:next-header buffer
                                                     header
                                                     news-header:unread?)
                      => (lambda (header)
-                          (news-group-buffer:header-mark-1 buffer header)))
+                          (or (news-group-buffer:header-mark buffer header)
+                              (news-group-buffer:thread-start-mark
+                               buffer
+                               (news-header:thread header))
+                              ls)))
                     (else ls))))))))
 
 (define (news-group-buffer-name group)
@@ -1193,12 +1197,9 @@ This shows News groups that have been created since the last time that
             (mark-left-inserting-copy
              (or (delete-news-thread-lines buffer thread)
                  (let loop ((thread thread))
-                   (let ((next
-                          (news-group-buffer:next-thread buffer thread)))
+                   (let ((next (news-group-buffer:next-thread buffer thread)))
                      (if next
-                         (or (news-group-buffer:thread-start-mark
-                              buffer
-                              next)
+                         (or (news-group-buffer:thread-start-mark buffer next)
                              (loop next))
                          (begin
                            (guarantee-newline (buffer-end buffer))
@@ -1207,11 +1208,38 @@ This shows News groups that have been created since the last time that
        (insert-news-thread-lines thread ls)
        (mark-temporary! ls)
        (update-subsequent-news-header-lines ls)))))
+
+(define (delete-news-thread-lines buffer thread)
+  (let ((region (news-thread-lines-region buffer thread)))
+    (and region
+        (let ((start (mark-right-inserting-copy (region-start region))))
+          (news-thread:clear-indices! thread)
+          (delete-string start (region-end region))
+          (mark-temporary! start)
+          start))))
+
+(define (news-thread-lines-region buffer thread)
+  (let ((ls (news-group-buffer:thread-start-mark buffer thread)))
+    (and ls
+        (let ((start (mark-temporary-copy ls))
+              (end (mark-temporary-copy (line-start ls 1 'LIMIT))))
+          (news-thread:for-each-header thread
+            (lambda (header)
+              (let ((ls (news-group-buffer:header-mark buffer header)))
+                (if ls
+                    (let ((nls (line-start ls 1 'LIMIT)))
+                      (if (mark< ls start) (move-mark-to! start ls))
+                      (if (mark> nls end) (move-mark-to! end nls)))))))
+          (make-region start end)))))
 \f
 (define (insert-news-thread-lines thread mark)
   (if (news-thread:show-collapsed? thread)
       (insert-collapsed-news-thread-line thread mark)
-      (insert-expanded-news-thread-lines thread mark)))
+      (insert-expanded-news-thread-lines thread mark))
+  (news-thread:for-each-real-header thread
+    (let ((buffer (mark-buffer mark)))
+      (lambda (header)
+       (news-header:article-browsed! header buffer)))))
 
 (define (insert-expanded-news-thread-lines thread mark)
   (let ((subject
@@ -1265,28 +1293,13 @@ This shows News groups that have been created since the last time that
      header
      mark)))
 
-(define (delete-news-thread-lines buffer thread)
-  (let ((region (news-thread-lines-region buffer thread)))
-    (and region
-        (let ((start (mark-right-inserting-copy (region-start region))))
-          (news-thread:clear-indices! thread)
-          (delete-string start (region-end region))
-          (mark-temporary! start)
-          start))))
-
-(define (news-thread-lines-region buffer thread)
-  (let ((ls (news-group-buffer:thread-start-mark buffer thread)))
-    (and ls
-        (let ((start (mark-temporary-copy ls))
-              (end (mark-temporary-copy (line-start ls 1 'LIMIT))))
-          (news-thread:for-each-header thread
-            (lambda (header)
-              (let ((ls (news-group-buffer:header-mark buffer header)))
-                (if ls
-                    (let ((nls (line-start ls 1 'LIMIT)))
-                      (if (mark< ls start) (move-mark-to! start ls))
-                      (if (mark> nls end) (move-mark-to! end nls)))))))
-          (make-region start end)))))
+(define (update-subsequent-news-header-lines ls)
+  (let ((header (region-get ls 'NEWS-HEADER #f)))
+    (if header
+       (set-news-header:index! header (mark-index ls))))
+  (let ((ls (line-start ls 1 #f)))
+    (if ls
+       (update-subsequent-news-header-lines ls))))
 \f
 (define (insert-news-header-line header indentation subject mark)
   (insert-subject-line (news-header:status header)
@@ -1356,14 +1369,6 @@ This shows News groups that have been created since the last time that
                              (re-match-start-index 1)
                              (re-match-end-index 1)))
       (or (rfc822-first-address from) from)))
-
-(define (update-subsequent-news-header-lines ls)
-  (let ((header (region-get ls 'NEWS-HEADER #f)))
-    (if header
-       (set-news-header:index! header (mark-index ls))))
-  (let ((ls (line-start ls 1 #f)))
-    (if ls
-       (update-subsequent-news-header-lines ls))))
 \f
 (define (news-group-buffer:header-mark buffer header)
   (let ((index (news-header:index header)))
@@ -1765,7 +1770,7 @@ With prefix argument, moves down several threads."
                  (partial-win t n)))))
 
       (define (next-loop-1 t n)
-       (next-loop t (if (news-thread:all-articles-seen? t) n (- n 1))))
+       (next-loop t (if (news-thread:all-articles-deleted? t) n (- n 1))))
 
       (define (prev-loop t n)
        (if (= n 0)
@@ -1776,7 +1781,7 @@ With prefix argument, moves down several threads."
                  (partial-win t n)))))
 
       (define (prev-loop-1 t n)
-       (prev-loop t (if (news-thread:all-articles-seen? t) n (+ n 1))))
+       (prev-loop t (if (news-thread:all-articles-deleted? t) n (+ n 1))))
 
       (define (win t)
        (news-group-buffer:move-to-header
@@ -1901,9 +1906,9 @@ With prefix argument, unmarks the previous several articles."
 
 (define (name->article-marker name)
   (case name
-    ((SEEN) news-header:article-seen!)
+    ((SEEN) news-header:article-deleted!)
     ((MARKED) news-header:article-marked!)
-    ((UNSEEN) news-header:article-unseen!)
+    ((UNSEEN) news-header:article-not-deleted!)
     ((IGNORED) news-header:article-ignored!)
     (else (error "Unknown marker name:" name))))
 \f
@@ -2117,7 +2122,7 @@ This command has no effect if the variable
                (let ((regions '()))
                  (for-each
                   (lambda (thread)
-                    (if (news-thread:all-articles-seen? thread)
+                    (if (news-thread:all-articles-deleted? thread)
                         (let ((region
                                (news-thread-lines-region buffer thread)))
                           (if region
@@ -2143,7 +2148,7 @@ This command has no effect if the variable
                (buffer-put! buffer 'NEWS-THREADS
                             (list->vector
                              (list-transform-negative threads
-                               news-thread:all-articles-seen?)))
+                               news-thread:all-articles-deleted?)))
                (if (and on-header?
                         (not (region-get (current-point) 'NEWS-HEADER #f)))
                    (let ((ls
@@ -2165,7 +2170,7 @@ This kills the current buffer."
              (lambda (thread)
                (news-thread:for-each-real-header thread
                  (lambda (header)
-                   (news-header:article-seen! header buffer))))))
+                   (news-header:article-deleted! header buffer))))))
          ((ref-command news-kill-current-buffer))))))
 
 (define-command news-group-quit
@@ -2215,12 +2220,12 @@ This kills the current buffer."
          (set-buffer-point! buffer (buffer-start buffer))
          (buffer-not-modified! buffer)
          (set-buffer-read-only! buffer)
-         (news-header:article-seen! header group-buffer)
+         (news-header:article-deleted! header group-buffer)
          (update-buffer-news-header-status group-buffer header)
          buffer)
        (begin
          (kill-buffer buffer)
-         (news-header:article-seen! header group-buffer)
+         (news-header:article-deleted! header group-buffer)
          (update-buffer-news-header-status group-buffer header)
          #f))))
 
@@ -2961,6 +2966,9 @@ C-c C-q  mail-fill-yanked-message (fill what was yanked)."
                    ((3)
                     (set! convert-entry convert-groups-init-file-entry-type-3)
                     validate-groups-init-file-entry-type-3)
+                   ((4)
+                    (set! convert-entry convert-groups-init-file-entry-type-4)
+                    validate-groups-init-file-entry-type-4)
                    (else #f)))))))
        (map (convert-entry connection) entries)))))
 
@@ -2969,21 +2977,23 @@ C-c C-q  mail-fill-yanked-message (fill what was yanked)."
     (write-init-file
      (groups-init-file-pathname server)
      buffer
-     3
+     4
      (let loop ((groups (vector->list groups)) (entries '()))
        (if (null? groups)
           entries
           (loop (cdr groups)
                 (let ((group (car groups)))
                   (if (and (not (news-group:subscribed? group))
-                           (ranges-empty? (news-group:ranges-seen group))
-                           (ranges-empty? (news-group:ranges-marked group)))
+                           (ranges-empty? (news-group:ranges-deleted group))
+                           (ranges-empty? (news-group:ranges-marked group))
+                           (ranges-empty? (news-group:ranges-browsed group)))
                       entries
                       (cons (vector (news-group:name group)
                                     (news-group:subscribed? group)
                                     (news-group:server-info group)
-                                    (news-group:ranges-seen group)
-                                    (news-group:ranges-marked group))
+                                    (news-group:ranges-deleted group)
+                                    (news-group:ranges-marked group)
+                                    (news-group:ranges-browsed group))
                             entries)))))))))
 
 (define (groups-init-file-pathname server)
@@ -3000,7 +3010,8 @@ C-c C-q  mail-fill-yanked-message (fill what was yanked)."
        (for-all? (cddr entry) range?)))
 
 (define ((convert-groups-init-file-entry-type-1 connection) entry)
-  (make-news-group-1 connection (car entry) (cadr entry) #f (cddr entry) '()))
+  (make-news-group-1 connection (car entry) (cadr entry) #f (cddr entry)
+                    '() '()))
 
 (define (validate-groups-init-file-entry-type-2 entry)
   (and (list? entry)
@@ -3016,6 +3027,7 @@ C-c C-q  mail-fill-yanked-message (fill what was yanked)."
                     (cadr entry)
                     (caddr entry)
                     (cdddr entry)
+                    '()
                     '()))
 
 (define (validate-groups-init-file-entry-type-3 entry)
@@ -3033,7 +3045,27 @@ C-c C-q  mail-fill-yanked-message (fill what was yanked)."
                     (vector-ref entry 1)
                     (vector-ref entry 2)
                     (vector-ref entry 3)
-                    (vector-ref entry 4)))
+                    (vector-ref entry 4)
+                    '()))
+
+(define (validate-groups-init-file-entry-type-4 entry)
+  (and (vector? entry)
+       (= (vector-length entry) 6)
+       (string? (vector-ref entry 0))
+       (boolean? (vector-ref entry 1))
+       (valid-group-server-info? (vector-ref entry 2))
+       (for-all? (vector-ref entry 3) range?)
+       (for-all? (vector-ref entry 4) range?)
+       (for-all? (vector-ref entry 5) range?)))
+
+(define ((convert-groups-init-file-entry-type-4 connection) entry)
+  (make-news-group-1 connection
+                    (vector-ref entry 0)
+                    (vector-ref entry 1)
+                    (vector-ref entry 2)
+                    (vector-ref entry 3)
+                    (vector-ref entry 4)
+                    (vector-ref entry 5)))
 
 (define (valid-group-server-info? server-info)
   (and (vector? server-info)
@@ -3142,16 +3174,17 @@ With prefix arg, replaces the groups list with the .newsrc entries."
                      (let ((group (find-news-group connection name)))
                        (if group
                            (begin
-                             (set-news-group:ranges-seen!
+                             (set-news-group:ranges-deleted!
                               group
                               (if replace?
                                   ranges
-                                  (merge-ranges (news-group:ranges-seen group)
-                                                ranges)))
-                             (news-group:guarantee-ranges-seen group)
+                                  (merge-ranges
+                                   (news-group:ranges-deleted group)
+                                   ranges)))
+                             (news-group:guarantee-ranges-deleted group)
                              group)
-                           (make-news-group-1 connection
-                                              name #f #f ranges '())))))
+                           (make-news-group-1 connection name #f #f ranges
+                                              '() '())))))
                 (if subscribed?
                     (subscribe-news-group buffer group)
                     (unsubscribe-news-group buffer group)))))
@@ -3239,7 +3272,7 @@ With prefix arg, replaces the file with the list information."
         (lambda (mark)
           (insert-char (if (news-group:subscribed? group) #\: #\!) mark)
           (let ((ranges
-                 (let ((ranges (news-group:guarantee-ranges-seen group))
+                 (let ((ranges (news-group:guarantee-ranges-deleted group))
                        (first (news-group:first-article group)))
                    (if (> first 1)
                        (canonicalize-ranges
@@ -3589,6 +3622,186 @@ With prefix arg, replaces the file with the list information."
                                   (set-car! node #f))))
                           (map cdr (cdr node)))))))))))
 \f
+;;;; Article Ranges
+
+(define (range? object)
+  (or (article-number? object)
+      (and (pair? object)
+          (article-number? (car object))
+          (article-number? (cdr object))
+          (<= (car object) (cdr object)))))
+
+(define (article-number? object)
+  (and (exact-integer? object)
+       (> object 0)))
+
+(define (make-range f l) (if (= f l) f (cons f l)))
+(define (range-first r)  (if (pair? r) (car r) r))
+(define (range-last r)   (if (pair? r) (cdr r) r))
+(define (range-length r) (if (pair? r) (+ (- (cdr r) (car r)) 1) 1))
+(define ranges-empty? null?)
+
+(define (count-ranges ranges)
+  (let loop ((ranges ranges) (count 0))
+    (if (null? ranges)
+       count
+       (loop (cdr ranges) (+ count (range-length (car ranges)))))))
+
+(define (canonicalize-ranges ranges)
+  (if (null? ranges)
+      ranges
+      (let ((ranges
+            (sort ranges (lambda (x y) (< (range-first x) (range-first y))))))
+       (let loop ((ranges ranges))
+         (if (not (null? (cdr ranges)))
+             (let ((x (car ranges))
+                   (y (cadr ranges)))
+               (if (<= (range-first y) (+ (range-last x) 1))
+                   (begin
+                     (set-car! ranges
+                               (make-range (range-first x)
+                                           (max (range-last x)
+                                                (range-last y))))
+                     (set-cdr! ranges (cddr ranges))
+                     (loop ranges))
+                   (loop (cdr ranges))))))
+       ranges)))
+
+(define (clip-ranges! ranges first last)
+  (let ((holder
+        (cons 'HOLDER
+              (let clip-first ((ranges ranges))
+                (cond ((or (null? ranges)
+                           (<= first (range-first (car ranges))))
+                       ranges)
+                      ((< (range-last (car ranges)) first)
+                       (clip-first (cdr ranges)))
+                      (else
+                       (set-car! ranges
+                                 (make-range first (range-last (car ranges))))
+                       ranges))))))
+    (let clip-last ((ranges (cdr holder)) (prev holder))
+      (cond ((null? ranges)
+            unspecific)
+           ((< (range-last (car ranges)) last)
+            (clip-last (cdr ranges) ranges))
+           ((> (range-first (car ranges)) last)
+            (set-cdr! prev '()))
+           (else
+            (if (> (range-last (car ranges)) last)
+                (set-car! ranges
+                          (make-range (range-first (car ranges))
+                                      last)))
+            (set-cdr! ranges '()))))
+    (cdr holder)))
+\f
+(define (complement-ranges ranges first last)
+  (if (null? ranges)
+      (list (make-range first last))
+      (let loop
+         ((e (range-last (car ranges)))
+          (ranges (cdr ranges))
+          (result
+           (let ((s (range-first (car ranges))))
+             (if (< first s)
+                 (list (make-range first (- s 1)))
+                 '()))))
+       (if (null? ranges)
+           (reverse! (if (< e last)
+                         (cons (make-range (+ e 1) last) result)
+                         result))
+           (loop (range-last (car ranges))
+                 (cdr ranges)
+                 (cons (make-range (+ e 1) (- (range-first (car ranges)) 1))
+                       result))))))
+
+(define (merge-ranges ranges ranges*)
+  (cond ((null? ranges)
+        ranges*)
+       ((null? ranges*)
+        ranges)
+       ((< (range-last (car ranges)) (range-first (car ranges*)))
+        (cons (car ranges) (merge-ranges (cdr ranges) ranges*)))
+       ((< (range-last (car ranges*)) (range-first (car ranges)))
+        (cons (car ranges*) (merge-ranges ranges (cdr ranges*))))
+       (else
+        (cons (make-range (min (range-first (car ranges))
+                               (range-first (car ranges*)))
+                          (max (range-last (car ranges))
+                               (range-last (car ranges*))))
+              (merge-ranges (cdr ranges) (cdr ranges*))))))
+
+(define (add-to-ranges! ranges number)
+  (let ((holder (cons 'HOLDER ranges)))
+    (let loop ((ranges ranges) (prev holder))
+      (if (null? ranges)
+         (set-cdr! prev (list (make-range number number)))
+         (let ((f (range-first (car ranges)))
+               (l (range-last (car ranges))))
+           (cond ((> number (+ l 1))
+                  (loop (cdr ranges) ranges))
+                 ((< number (- f 1))
+                  (set-cdr! prev (cons (make-range number number) ranges)))
+                 (else
+                  (let ((f (min f number))
+                        (l (max l number)))
+                    (if (and (not (null? (cdr ranges)))
+                             (= (+ l 1) (range-first (cadr ranges))))
+                        (begin
+                          (set-car! ranges
+                                    (make-range f (range-last (cadr ranges))))
+                          (set-cdr! ranges (cddr ranges)))
+                        (set-car! ranges (make-range f l)))))))))
+    (cdr holder)))
+\f
+(define (remove-from-ranges! ranges number)
+  (let ((holder (cons 'HOLDER ranges)))
+    (let loop ((ranges ranges) (prev holder))
+      (if (not (null? ranges))
+         (let ((f (range-first (car ranges)))
+               (l (range-last (car ranges))))
+           (cond ((> number l)
+                  (loop (cdr ranges) ranges))
+                 ((>= number f)
+                  (if (= number f)
+                      (if (= number l)
+                          (set-cdr! prev (cdr ranges))
+                          (set-car! ranges (make-range (+ f 1) l)))
+                      (if (= number l)
+                          (set-car! ranges (make-range f (- l 1)))
+                          (begin
+                            (set-car! ranges (make-range (+ number 1) l))
+                            (set-cdr! prev
+                                      (cons (make-range f (- number 1))
+                                            ranges))))))))))
+    (cdr holder)))
+
+(define (member-of-ranges? ranges number)
+  (let loop ((ranges ranges))
+    (and (not (null? ranges))
+        (or (<= (range-first (car ranges)) number (range-last (car ranges)))
+            (loop (cdr ranges))))))
+
+(define (ranges->list ranges)
+  (let loop ((ranges ranges) (result '()))
+    (if (null? ranges)
+       (reverse! result)
+       (loop (cdr ranges)
+             (let ((e (range-last (car ranges))))
+               (let loop ((n (range-first (car ranges))) (result result))
+                 (let ((result (cons n result)))
+                   (if (= n e)
+                       result
+                       (loop (+ n 1) result)))))))))
+
+(define (for-each-range-element procedure ranges)
+  (for-each (lambda (range)
+             (let ((e (+ (range-last range) 1)))
+               (do ((n (range-first range) (+ n 1)))
+                   ((= n e) unspecific)
+                 (procedure n))))
+           ranges))
+\f
 ;;;; News-Group Extensions
 
 (define-structure (news-group-extra
@@ -3596,10 +3809,11 @@ With prefix arg, replaces the file with the list information."
                   (conc-name news-group-extra:)
                   (constructor make-news-group-extra ()))
   (subscribed? #f)
-  (ranges-seen '())
+  (ranges-deleted '())
   (index #f)
   (ignored-subjects 'UNKNOWN)
-  (ranges-marked '()))
+  (ranges-marked '())
+  (ranges-browsed '()))
 
 (define (get-news-group-extra group write?)
   (or (news-group:reader-hook group)
@@ -3613,11 +3827,11 @@ With prefix arg, replaces the file with the list information."
 (define (set-news-group:subscribed?! group value)
   (set-news-group-extra:subscribed?! (get-news-group-extra group #t) value))
 
-(define (news-group:ranges-seen group)
-  (news-group-extra:ranges-seen (get-news-group-extra group #f)))
+(define (news-group:ranges-deleted group)
+  (news-group-extra:ranges-deleted (get-news-group-extra group #f)))
 
-(define (set-news-group:ranges-seen! group value)
-  (set-news-group-extra:ranges-seen! (get-news-group-extra group #t) value))
+(define (set-news-group:ranges-deleted! group value)
+  (set-news-group-extra:ranges-deleted! (get-news-group-extra group #t) value))
 
 (define (news-group:index group)
   (news-group-extra:index (get-news-group-extra group #f)))
@@ -3638,13 +3852,20 @@ With prefix arg, replaces the file with the list information."
 (define (set-news-group:ranges-marked! group value)
   (set-news-group-extra:ranges-marked! (get-news-group-extra group #t) value))
 
+(define (news-group:ranges-browsed group)
+  (news-group-extra:ranges-browsed (get-news-group-extra group #f)))
+
+(define (set-news-group:ranges-browsed! group value)
+  (set-news-group-extra:ranges-browsed! (get-news-group-extra group #t) value))
+
 (define (make-news-group-1 connection name subscribed? server-info
-                          ranges-seen ranges-marked)
+                          ranges-deleted ranges-marked ranges-browsed)
   (let ((group (make-news-group connection name)))
     (set-news-group:subscribed?! group subscribed?)
     (set-news-group:server-info! group server-info)
-    (set-news-group:ranges-seen! group (canonicalize-ranges ranges-seen))
+    (set-news-group:ranges-deleted! group (canonicalize-ranges ranges-deleted))
     (set-news-group:ranges-marked! group (canonicalize-ranges ranges-marked))
+    (set-news-group:ranges-browsed! group (canonicalize-ranges ranges-browsed))
     group))
 \f
 (define (news-group:get-threads group argument buffer)
@@ -3664,7 +3885,7 @@ With prefix arg, replaces the file with the list information."
               (ref-variable news-group-show-seen-headers buffer))
           threads
           (list-transform-negative threads
-            news-thread:all-articles-seen?))))))
+            news-thread:all-articles-deleted?))))))
 
 (define (news-group:get-headers group argument buffer)
   (let ((connection (news-group:connection group))
@@ -3725,13 +3946,13 @@ With prefix arg, replaces the file with the list information."
       (news-group:get-headers group #f buffer)))
 \f
 (define (article-number-seen! group number)
-  (set-news-group:ranges-seen!
+  (set-news-group:ranges-deleted!
    group
-   (add-to-ranges! (news-group:guarantee-ranges-seen group) number)))
+   (add-to-ranges! (news-group:guarantee-ranges-deleted group) number)))
 
 (define (news-group:unread-header-numbers group)
   (ranges->list
-   (complement-ranges (news-group:guarantee-ranges-seen group)
+   (complement-ranges (news-group:guarantee-ranges-deleted group)
                      (news-group:first-article group)
                      (news-group:last-article group))))
 
@@ -3750,7 +3971,7 @@ With prefix arg, replaces the file with the list information."
     (news-group:update-server-info! group)
     (message msg "done"))
   (if (news-group:active? group)
-      (news-group:guarantee-ranges-seen group)))
+      (news-group:guarantee-ranges-deleted group)))
 
 (define (news-group:purge-and-compact-headers! group buffer)
   (let ((msg
@@ -3766,7 +3987,7 @@ With prefix arg, replaces the file with the list information."
                  (and (not (ref-variable news-group-keep-ignored-headers
                                          buffer))
                       (news-header:ignore? header)))))
-         news-header:article-seen?))
+         news-header:article-deleted?))
     (message msg "done")))
 
 (define (news-group:number-of-articles group)
@@ -3774,7 +3995,8 @@ With prefix arg, replaces the file with the list information."
     (and estimate
         (if (news-group:reader-hook group)
             (let ((n-seen
-                   (count-ranges (news-group:guarantee-ranges-seen group))))
+                   (count-ranges
+                    (news-group:guarantee-ranges-deleted group))))
               (if (= n-seen 0)
                   estimate
                   (- (- (+ (news-group:last-article group) 1)
@@ -3782,66 +4004,90 @@ With prefix arg, replaces the file with the list information."
                      n-seen)))
             estimate))))
 
-(define (news-group:guarantee-ranges-seen group)
+(define (news-group:guarantee-ranges-deleted group)
   (let ((ranges
-        (clip-ranges! (news-group:ranges-seen group)
+        (clip-ranges! (news-group:ranges-deleted group)
                       (news-group:first-article group)
                       (news-group:last-article group))))
-    (set-news-group:ranges-seen! group ranges)
+    (set-news-group:ranges-deleted! group ranges)
     ranges))
 \f
-(define (news-header:article-seen? header)
-  (member-of-ranges? (news-group:ranges-seen (news-header:group header))
+(define ((range-predicate group-ranges) header)
+  (member-of-ranges? (group-ranges (news-header:group header))
                     (news-header:number header)))
 
-(define (news-group:article-seen! group header buffer)
-  (news-group:article-unmarked! group header buffer)
-  (news-group:adjust-article-status!
-   group header buffer #t
-   (news-group:seen-article-updater add-to-ranges!)))
-
-(define (news-group:article-unseen! group header buffer)
-  (news-group:article-unmarked! group header buffer)
-  (news-group:adjust-article-status!
-   group header buffer #t
-   (news-group:seen-article-updater remove-from-ranges!)))
-
-(define ((news-group:seen-article-updater procedure) group number)
-  (set-news-group:ranges-seen! group
-                              (procedure (news-group:ranges-seen group)
-                                         number)))
-
-(define (news-header:article-marked? header)
-  (member-of-ranges? (news-group:ranges-marked (news-header:group header))
-                    (news-header:number header)))
-
-(define (news-group:article-marked! group header buffer)
-  (news-group:article-unseen! group header buffer)
-  (news-group:adjust-article-status!
-   group header buffer #f
-   (news-group:marked-article-updater add-to-ranges!)))
-
-(define (news-group:article-unmarked! group header buffer)
-  (news-group:adjust-article-status!
-   group header buffer #f
-   (news-group:marked-article-updater remove-from-ranges!)))
-
-(define ((news-group:marked-article-updater procedure) group number)
-  (set-news-group:ranges-marked! group
-                                (procedure (news-group:ranges-marked group)
-                                           number)))
-
-(define (news-group:adjust-article-status! group header buffer handle-xrefs?
-                                          procedure)
+(define news-header:article-deleted?
+  (range-predicate news-group:ranges-deleted))
+
+(define news-header:article-marked?
+  (range-predicate news-group:ranges-marked))
+
+(define (news-group:article-browsed? group number)
+  (member-of-ranges? (news-group:ranges-browsed group) number))
+
+(define (ranges-marker group-ranges set-group-ranges! handle-xrefs? procedure)
+  (news-group:adjust-article-status! handle-xrefs?
+    (lambda (group number)
+      (set-group-ranges! group (procedure (group-ranges group) number)))))
+
+(define (ranges-deleted-marker procedure)
+  (let ((marker
+        (ranges-marker news-group:ranges-deleted
+                       set-news-group:ranges-deleted!
+                       #t
+                       procedure)))
+    (lambda (header buffer)
+      (news-group:article-unmarked! header buffer)
+      (marker header buffer))))
+
+(define news-group:article-deleted!
+  (ranges-deleted-marker add-to-ranges!))
+
+(define news-group:article-not-deleted!
+  (ranges-deleted-marker remove-from-ranges!))
+
+(define news-group:article-marked!
+  (let ((marker
+        (ranges-marker news-group:ranges-marked
+                       set-news-group:ranges-marked!
+                       #t
+                       add-to-ranges!)))
+    (lambda (header buffer)
+      (news-group:article-not-deleted! header buffer)
+      (marker header buffer))))
+
+(define news-group:article-unmarked!
+  (ranges-marker news-group:ranges-marked
+                set-news-group:ranges-marked!
+                #t
+                remove-from-ranges!))
+
+(define news-group:article-browsed!
+  (ranges-marker news-group:ranges-browsed
+                set-news-group:ranges-browsed!
+                #f
+                add-to-ranges!))
+\f
+(define ((news-group:adjust-article-status! handle-xrefs? procedure)
+        header buffer)
   (let ((do-it
         (lambda (group number)
           (procedure group number)
           (news-group:maybe-defer-update buffer group))))
-    (do-it group (news-header:number header))
+    (do-it (news-header:group header) (news-header:number header))
     (if handle-xrefs?
-       (news-group:process-cross-posts group header
-         (lambda (group xref)
-           (do-it group (token->number (cdr xref))))))))
+       (news-group:process-cross-posts header do-it))))
+
+(define (news-group:process-cross-posts header process-header)
+  (for-each (let ((connection
+                  (news-group:connection (news-header:group header))))
+             (lambda (xref)
+               (let ((group (find-news-group connection (car xref))))
+                 (if (and group (news-group:subscribed? group))
+                     (let ((number (token->number (cdr xref))))
+                       (if (not (news-group:article-browsed? group number))
+                           (process-header group number)))))))
+           (news-header:xref header)))
 
 (define (defer-marking-updates buffer thunk)
   (fluid-let ((news-group:adjust-article-status!:deferred-updates (list #t)))
@@ -3857,7 +4103,7 @@ With prefix arg, replaces the file with the list information."
        (update-news-groups-buffers buffer group))))
 
 (define news-group:adjust-article-status!:deferred-updates #f)
-\f
+
 (define (news-group:articles-marked? group)
   (not (ranges-empty? (news-group:ranges-marked group))))
 
@@ -3868,7 +4114,7 @@ With prefix arg, replaces the file with the list information."
 (define (news-header:read-marked-body header buffer)
   (news-header:guarantee-full-text! header)
   (news-header:pre-read-body header)
-  (news-header:article-unseen! header buffer)
+  (news-header:article-not-deleted! header buffer)
   (let ((buffer
         (if (news-group-buffer? buffer)
             buffer
@@ -3890,7 +4136,7 @@ With prefix arg, replaces the file with the list information."
         (let ((group (news-header:group header)))
           (hash-table/put! table subject t)
           (news-group:ignored-subjects-modified! group)
-          (news-group:process-cross-posts group header
+          (news-group:process-cross-posts header
                                           (ignore-subject-marker subject t))
           #t))))
 
@@ -3902,42 +4148,36 @@ With prefix arg, replaces the file with the list information."
           (and (not (fix:= 0 (string-length subject)))
                (hash-table/get table subject #f))))))
 
-(define (news-group:article-ignored! group header buffer)
+(define (news-group:article-ignored! header buffer)
   (let ((subject (canonicalize-subject (news-header:subject header))))
     (if (not (fix:= 0 (string-length subject)))
-       (let ((process-group
+       (let ((process-header
               (ignore-subject-marker subject (get-universal-time))))
-         (process-group group #f)
-         (news-group:process-cross-posts group header process-group))))
-  (news-group:article-seen! group header buffer))
+         (process-header (news-header:group header)
+                         (news-header:number header))
+         (news-group:process-cross-posts header process-header))))
+  (news-group:article-deleted! header buffer))
 
-(define ((ignore-subject-marker subject t) group xref)
-  xref
+(define ((ignore-subject-marker subject t) group number)
+  number
   (hash-table/put! (news-group:get-ignored-subjects group #t) subject t)
   (news-group:ignored-subjects-modified! group))
 
-(define (news-group:article-not-ignored! group header buffer)
+(define (news-group:article-not-ignored! header buffer)
   buffer
   (let ((subject (canonicalize-subject (news-header:subject header))))
     (if (not (fix:= 0 (string-length subject)))
-       (let ((process-group
-              (lambda (group xref)
-                xref
+       (let ((process-header
+              (lambda (group number)
+                number
                 (let ((table (news-group:get-ignored-subjects group #f)))
                   (if (and table (hash-table/get table subject #f))
                       (begin
                         (hash-table/remove! table subject)
                         (news-group:ignored-subjects-modified! group)))))))
-         (process-group group #f)
-         (news-group:process-cross-posts group header process-group)))))
-
-(define (news-group:process-cross-posts group header process-group)
-  (for-each (let ((connection (news-group:connection group)))
-             (lambda (xref)
-               (let ((group (find-news-group connection (car xref))))
-                 (if (and group (news-group:subscribed? group))
-                     (process-group group xref)))))
-           (news-header:xref header)))
+         (process-header (news-header:group header)
+                         (news-header:number header))
+         (news-group:process-cross-posts header process-header)))))
 
 (define (news-group:get-ignored-subjects group intern?)
   (or (let ((table (news-group:ignored-subjects group)))
@@ -3961,186 +4201,6 @@ With prefix arg, replaces the file with the list information."
   (and (pair? (news-group:ignored-subjects group))
        (cdr (news-group:ignored-subjects group))))
 \f
-;;;; Article Ranges
-
-(define (range? object)
-  (or (article-number? object)
-      (and (pair? object)
-          (article-number? (car object))
-          (article-number? (cdr object))
-          (<= (car object) (cdr object)))))
-
-(define (article-number? object)
-  (and (exact-integer? object)
-       (> object 0)))
-
-(define (make-range f l) (if (= f l) f (cons f l)))
-(define (range-first r)  (if (pair? r) (car r) r))
-(define (range-last r)   (if (pair? r) (cdr r) r))
-(define (range-length r) (if (pair? r) (+ (- (cdr r) (car r)) 1) 1))
-(define ranges-empty? null?)
-
-(define (count-ranges ranges)
-  (let loop ((ranges ranges) (count 0))
-    (if (null? ranges)
-       count
-       (loop (cdr ranges) (+ count (range-length (car ranges)))))))
-
-(define (canonicalize-ranges ranges)
-  (if (null? ranges)
-      ranges
-      (let ((ranges
-            (sort ranges (lambda (x y) (< (range-first x) (range-first y))))))
-       (let loop ((ranges ranges))
-         (if (not (null? (cdr ranges)))
-             (let ((x (car ranges))
-                   (y (cadr ranges)))
-               (if (<= (range-first y) (+ (range-last x) 1))
-                   (begin
-                     (set-car! ranges
-                               (make-range (range-first x)
-                                           (max (range-last x)
-                                                (range-last y))))
-                     (set-cdr! ranges (cddr ranges))
-                     (loop ranges))
-                   (loop (cdr ranges))))))
-       ranges)))
-
-(define (clip-ranges! ranges first last)
-  (let ((holder
-        (cons 'HOLDER
-              (let clip-first ((ranges ranges))
-                (cond ((or (null? ranges)
-                           (<= first (range-first (car ranges))))
-                       ranges)
-                      ((< (range-last (car ranges)) first)
-                       (clip-first (cdr ranges)))
-                      (else
-                       (set-car! ranges
-                                 (make-range first (range-last (car ranges))))
-                       ranges))))))
-    (let clip-last ((ranges (cdr holder)) (prev holder))
-      (cond ((null? ranges)
-            unspecific)
-           ((< (range-last (car ranges)) last)
-            (clip-last (cdr ranges) ranges))
-           ((> (range-first (car ranges)) last)
-            (set-cdr! prev '()))
-           (else
-            (if (> (range-last (car ranges)) last)
-                (set-car! ranges
-                          (make-range (range-first (car ranges))
-                                      last)))
-            (set-cdr! ranges '()))))
-    (cdr holder)))
-\f
-(define (complement-ranges ranges first last)
-  (if (null? ranges)
-      (list (make-range first last))
-      (let loop
-         ((e (range-last (car ranges)))
-          (ranges (cdr ranges))
-          (result
-           (let ((s (range-first (car ranges))))
-             (if (< first s)
-                 (list (make-range first (- s 1)))
-                 '()))))
-       (if (null? ranges)
-           (reverse! (if (< e last)
-                         (cons (make-range (+ e 1) last) result)
-                         result))
-           (loop (range-last (car ranges))
-                 (cdr ranges)
-                 (cons (make-range (+ e 1) (- (range-first (car ranges)) 1))
-                       result))))))
-
-(define (merge-ranges ranges ranges*)
-  (cond ((null? ranges)
-        ranges*)
-       ((null? ranges*)
-        ranges)
-       ((< (range-last (car ranges)) (range-first (car ranges*)))
-        (cons (car ranges) (merge-ranges (cdr ranges) ranges*)))
-       ((< (range-last (car ranges*)) (range-first (car ranges)))
-        (cons (car ranges*) (merge-ranges ranges (cdr ranges*))))
-       (else
-        (cons (make-range (min (range-first (car ranges))
-                               (range-first (car ranges*)))
-                          (max (range-last (car ranges))
-                               (range-last (car ranges*))))
-              (merge-ranges (cdr ranges) (cdr ranges*))))))
-
-(define (add-to-ranges! ranges number)
-  (let ((holder (cons 'HOLDER ranges)))
-    (let loop ((ranges ranges) (prev holder))
-      (if (null? ranges)
-         (set-cdr! prev (list (make-range number number)))
-         (let ((f (range-first (car ranges)))
-               (l (range-last (car ranges))))
-           (cond ((> number (+ l 1))
-                  (loop (cdr ranges) ranges))
-                 ((< number (- f 1))
-                  (set-cdr! prev (cons (make-range number number) ranges)))
-                 (else
-                  (let ((f (min f number))
-                        (l (max l number)))
-                    (if (and (not (null? (cdr ranges)))
-                             (= (+ l 1) (range-first (cadr ranges))))
-                        (begin
-                          (set-car! ranges
-                                    (make-range f (range-last (cadr ranges))))
-                          (set-cdr! ranges (cddr ranges)))
-                        (set-car! ranges (make-range f l)))))))))
-    (cdr holder)))
-\f
-(define (remove-from-ranges! ranges number)
-  (let ((holder (cons 'HOLDER ranges)))
-    (let loop ((ranges ranges) (prev holder))
-      (if (not (null? ranges))
-         (let ((f (range-first (car ranges)))
-               (l (range-last (car ranges))))
-           (cond ((> number l)
-                  (loop (cdr ranges) ranges))
-                 ((>= number f)
-                  (if (= number f)
-                      (if (= number l)
-                          (set-cdr! prev (cdr ranges))
-                          (set-car! ranges (make-range (+ f 1) l)))
-                      (if (= number l)
-                          (set-car! ranges (make-range f (- l 1)))
-                          (begin
-                            (set-car! ranges (make-range (+ number 1) l))
-                            (set-cdr! prev
-                                      (cons (make-range f (- number 1))
-                                            ranges))))))))))
-    (cdr holder)))
-
-(define (member-of-ranges? ranges number)
-  (let loop ((ranges ranges))
-    (and (not (null? ranges))
-        (or (<= (range-first (car ranges)) number (range-last (car ranges)))
-            (loop (cdr ranges))))))
-
-(define (ranges->list ranges)
-  (let loop ((ranges ranges) (result '()))
-    (if (null? ranges)
-       (reverse! result)
-       (loop (cdr ranges)
-             (let ((e (range-last (car ranges))))
-               (let loop ((n (range-first (car ranges))) (result result))
-                 (let ((result (cons n result)))
-                   (if (= n e)
-                       result
-                       (loop (+ n 1) result)))))))))
-
-(define (for-each-range-element procedure ranges)
-  (for-each (lambda (range)
-             (let ((e (+ (range-last range) 1)))
-               (do ((n (range-first range) (+ n 1)))
-                   ((= n e) unspecific)
-                 (procedure n))))
-           ranges))
-\f
 ;;;; News-Header Extensions
 
 (define-structure (news-header-extra
@@ -4163,11 +4223,11 @@ With prefix arg, replaces the file with the list information."
               (not number))
           #\D)
          ((news-header:ignore? header)
-          (set-news-group:ranges-seen!
+          (set-news-group:ranges-deleted!
            group
-           (add-to-ranges! (news-group:ranges-seen group) number))
+           (add-to-ranges! (news-group:ranges-deleted group) number))
           #\I)
-         ((news-header:article-seen? header) #\D)
+         ((news-header:article-deleted? header) #\D)
          ((news-header:article-marked? header) #\M)
          (else #\space))))
 
@@ -4183,33 +4243,35 @@ With prefix arg, replaces the file with the list information."
 (define (set-news-header:index! header value)
   (set-news-header-extra:index! (get-news-header-extra header #t) value))
 
-(define (news-header:article-seen! header buffer)
+(define (news-header:article-deleted! header buffer)
   (if (not (eqv? (news-header:status header) #\I))
       (set-news-header:status! header #\D))
-  (news-group:article-seen! (news-header:group header) header buffer))
+  (news-group:article-deleted! header buffer))
 
-(define (news-header:article-unseen! header buffer)
+(define (news-header:article-not-deleted! header buffer)
   (set-news-header:status! header #\space)
-  (news-group:article-unseen! (news-header:group header) header buffer))
+  (news-group:article-not-deleted! header buffer))
 
 (define (news-header:article-marked! header buffer)
   (if (not (news-header:pre-read-body? header))
       (begin
        (set-news-header:status! header #\M)
-       (news-group:article-marked! (news-header:group header)
-                                   header buffer))))
+       (news-group:article-marked! header buffer))))
+
+(define (news-header:article-browsed! header buffer)
+  (news-group:article-browsed! header buffer))
 
 (define (news-header:article-ignored! header buffer)
   (set-news-header:status! header #\I)
-  (news-group:article-ignored! (news-header:group header) header buffer))
+  (news-group:article-ignored! header buffer))
 
 (define (news-header:article-not-ignored! header buffer)
   (set-news-header:status! header #\space)
-  (news-group:article-not-ignored! (news-header:group header) header buffer))
+  (news-group:article-not-ignored! header buffer))
 
 (define (news-header:unread? header)
   (and (news-header:real? header)
-       (not (news-header:article-seen? header))))
+       (not (news-header:article-deleted? header))))
 \f
 (define (news-header:next-in-thread header)
   (let scan-down ((header header))
@@ -4318,10 +4380,10 @@ With prefix arg, replaces the file with the list information."
            bodies
            (loop header bodies))))))
 
-(define (news-thread:all-articles-seen? thread)
+(define (news-thread:all-articles-deleted? thread)
   (let loop ((header (news-thread:first-header thread news-header:real?)))
     (or (not header)
-       (and (news-header:article-seen? header)
+       (and (news-header:article-deleted? header)
             (loop (news-thread:next-header header news-header:real?))))))
 
 (define (news-thread:show-collapsed? thread)