From: Arthur Gleckler <edu/mit/csail/zurich/arthur>
Date: Tue, 24 Nov 1992 04:03:25 +0000 (+0000)
Subject: Fix bug that makes sort commands sometimes duplicate the text in the
X-Git-Tag: 20090517-FFI~8710
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=88ca444b86a78be9133bcfef8f37b73f0c5449b0;p=mit-scheme.git

Fix bug that makes sort commands sometimes duplicate the text in the
sorted region.
---

diff --git a/v7/src/edwin/sort.scm b/v7/src/edwin/sort.scm
index 6eb08c4d9..95581991c 100644
--- a/v7/src/edwin/sort.scm
+++ b/v7/src/edwin/sort.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: sort.scm,v 1.3 1992/11/20 19:10:55 cph Exp $
+;;;	$Id: sort.scm,v 1.4 1992/11/24 04:03:25 arthur Exp $
 ;;;
 ;;;	Copyright (c) 1992 Massachusetts Institute of Technology
 ;;;
@@ -74,24 +74,33 @@
     (mark-temporary! delete-end)))
 
 (define (identify-records region forward-record record-end)
-  (let ((limit (region-end region)))
-    (let next-record ((start (region-start region)))
-      (if (and start (mark< start limit))
-	  (let ((end (record-end start)))
-	    (if (and end (mark< end limit))
-		(cons (cons start end)
-		      (next-record (forward-record end)))
-		(list (cons start (region-end region)))))
-	  '()))))
+  (define (mark-temporary-right-inserting-copy mark)
+    (make-temporary-mark (mark-group mark) (mark-index mark) false))
+  (map
+   (lambda (record)
+     (cons (car record)
+	   (mark-temporary-right-inserting-copy (cdr record))))
+   (let ((limit (region-end region)))
+     (let next-record ((start (region-start region)))
+       (if (and start (mark< start limit))
+	   (let ((end (record-end start)))
+	     (if (and end (mark< end limit))
+		 (cons (cons start end)
+		       (next-record (forward-record end)))
+		 (list (cons start (region-end region)))))
+	   '())))))
 
 (define (insert-reordered-region start end sorted-list unsorted-list)
-  (let ((insert-mark (mark-left-inserting-copy end)))
+  (let ((end-mark (mark-right-inserting-copy end))
+	(insert-mark (mark-left-inserting-copy end)))
     (let next-element ((previous start)
 		       (sorted-list sorted-list)
 		       (unsorted-list unsorted-list))
       (if (null? sorted-list)
-	  (if (mark< previous end)
-	      (insert-string (extract-string previous end) insert-mark))
+	  (if (mark< previous end-mark)
+	      (insert-string
+	       (extract-string previous end-mark)
+	       insert-mark))
 	  (begin
 	    (if (mark< previous (caar unsorted-list))
 		(insert-string (extract-string previous (caar unsorted-list))
@@ -103,6 +112,7 @@
 	    (next-element (cdar unsorted-list)
 			  (cdr sorted-list)
 			  (cdr unsorted-list)))))
+    (mark-temporary! end-mark)
     (mark-temporary! insert-mark)))
 
 (define (sort-textual-comparison start1 end1 start2 end2)