Fix two bugs. Discard permanent marks when no longer needed.
authorChris Hanson <org/chris-hanson/cph>
Fri, 20 Nov 1992 18:23:27 +0000 (18:23 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 20 Nov 1992 18:23:27 +0000 (18:23 +0000)
Repaginate.

v7/src/edwin/sort.scm

index 282814283de3235f066650663f6f6d90510ae9fe..baad66ccdedbb216eabff77bae3816772be5150f 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: sort.scm,v 1.1 1992/11/01 07:11:48 arthur Exp $
+;;;    $Id: sort.scm,v 1.2 1992/11/20 18:23:27 cph Exp $
 ;;;
 ;;;    Copyright (c) 1992 Massachusetts Institute of Technology
 ;;;
                           start2
                           (key-end start2)))))))))
     (insert-reordered-region start end sorted-list unsorted-list)
-    (kill-string start delete-end)))
+    (kill-string start delete-end)
+    (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 start
+      (if (and start (mark< start limit))
          (let ((end (record-end start)))
            (if (and end (mark< end limit))
                (cons (cons start end)
     (let next-element ((previous start)
                       (sorted-list sorted-list)
                       (unsorted-list unsorted-list))
-      (if (not (null? sorted-list))
+      (if (null? sorted-list)
+         (if (mark< previous end)
+             (insert-string (extract-string previous end) insert-mark))
          (begin
-           (insert-string
-            (extract-string previous
-                            (caar unsorted-list))
-            insert-mark)
+           (if (mark< previous (caar unsorted-list))
+               (insert-string (extract-string previous (caar unsorted-list))
+                              insert-mark))
            (insert-string
             (extract-string (caar sorted-list)
                             (cdar sorted-list))
             insert-mark)
            (next-element (cdar unsorted-list)
                          (cdr sorted-list)
-                         (cdr unsorted-list)))))))
+                         (cdr unsorted-list)))))
+    (mark-temporary! delete-end)))
 
 (define (sort-textual-comparison start1 end1 start2 end2)
   (string<? (extract-string start1 end1)
       (if (or (not value1) (not value2))
          (string<? string1 string2)
          (< value1 value2)))))
-
+\f
 (define-command sort-lines
   "Sort lines in region in ascending order by comparing the text of
 the lines.  Argument means sort in descending order."
@@ -160,7 +163,7 @@ the pages.  Argument means sort in descending order."
                   identity-procedure
                   (lambda (mark) (line-end mark 0))
                   sort-textual-comparison))))
-
+\f
 (define ((sort-fields compare) field region)
   (if (zero? field) (editor-error "Field number must be non-zero."))
   (let ((end (line-end (region-end region) 0)))