Change mark data structure to store index instead of position.

Eliminate `mark-position' operation, which is no longer useful.

These changes require microcode version 11.73 or later.

diff --git a/v7/src/edwin/bufwin.scm b/v7/src/edwin/bufwin.scm
index 3bac1f0f89b7742e511d204ae8896bbad6a538b4..228b1745337b5dc499b794f9a35c8eccbfc37730 100644 (file)
--- a/v7/src/edwin/bufwin.scm
+++ b/v7/src/edwin/bufwin.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwin.scm,v 1.291 1991/04/01 10:06:30 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwin.scm,v 1.292 1991/04/02 19:55:19 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -211,7 +211,7 @@
   (with-instance-variables buffer-window window () point))
 
 (define-integrable (%window-point-index window)
-  (mark-index-integrable (%window-point window)))
+  (mark-index (%window-point window)))
 
 (define-integrable (%set-window-point! window point*)
   (with-instance-variables buffer-window window (point*)
@@ -219,9 +219,9 @@
 
 (define-integrable (%set-window-point-index! window index)
   (%set-window-point! window
-                     (%make-permanent-mark (%window-group window)
-                                           index
-                                           true)))
+                     (make-permanent-mark (%window-group window)
+                                          index
+                                          true)))
 
 (define-integrable (%window-cursor-inferior window)
   (with-instance-variables buffer-window window () cursor-inferior))
@@ -262,7 +262,7 @@
   (with-instance-variables buffer-window window () current-start-mark))
 
 (define-integrable (%window-current-start-index window)
-  (mark-index-integrable (%window-current-start-mark window)))
+  (mark-index (%window-current-start-mark window)))
 
 (define-integrable (%set-window-current-start-mark! window mark)
   (with-instance-variables buffer-window window (mark)
@@ -272,7 +272,7 @@
   (with-instance-variables buffer-window window () current-end-mark))
 
 (define-integrable (%window-current-end-index window)
-  (mark-index-integrable (%window-current-end-mark window)))
+  (mark-index (%window-current-end-mark window)))
 
 (define-integrable (%set-window-current-end-mark! window mark)
   (with-instance-variables buffer-window window (mark)
@@ -310,7 +310,7 @@
   (with-instance-variables buffer-window window () start-mark))
 
 (define-integrable (%window-start-index window)
-  (mark-index-integrable (%window-start-mark window)))
+  (mark-index (%window-start-mark window)))
 
 (define-integrable (%set-window-start-mark! window mark)
   (with-instance-variables buffer-window window (mark)
@@ -320,7 +320,7 @@
   (with-instance-variables buffer-window window () start-line-mark))
 
 (define-integrable (%window-start-line-index window)
-  (mark-index-integrable (%window-start-line-mark window)))
+  (mark-index (%window-start-line-mark window)))
 
 (define-integrable (%set-window-start-line-mark! window mark)
   (with-instance-variables buffer-window window (mark)
@@ -344,7 +344,7 @@
   (with-instance-variables buffer-window window () start-changes-mark))
 
 (define-integrable (%window-start-changes-index window)
-  (mark-index-integrable (%window-start-changes-mark window)))
+  (mark-index (%window-start-changes-mark window)))
 
 (define-integrable (%set-window-start-changes-mark! window mark)
   (with-instance-variables buffer-window window (mark)
@@ -354,7 +354,7 @@
   (with-instance-variables buffer-window window () end-changes-mark))
 
 (define-integrable (%window-end-changes-index window)
-  (mark-index-integrable (%window-end-changes-mark window)))
+  (mark-index (%window-end-changes-mark window)))
 
 (define-integrable (%set-window-end-changes-mark! window mark)
   (with-instance-variables buffer-window window (mark)
@@ -371,7 +371,7 @@
   (with-instance-variables buffer-window window () start-clip-mark))
 
 (define-integrable (%window-start-clip-index window)
-  (mark-index-integrable (%window-start-clip-mark window)))
+  (mark-index (%window-start-clip-mark window)))
 
 (define-integrable (%set-window-start-clip-mark! window mark)
   (with-instance-variables buffer-window window (mark)
@@ -381,7 +381,7 @@
   (with-instance-variables buffer-window window () end-clip-mark))
 
 (define-integrable (%window-end-clip-index window)
-  (mark-index-integrable (%window-end-clip-mark window)))
+  (mark-index (%window-end-clip-mark window)))
 
 (define-integrable (%set-window-end-clip-mark! window mark)
   (with-instance-variables buffer-window window (mark)
@@ -459,7 +459,15 @@
 \f
 ;;;; Outlines
 
-(define-structure (outline (constructor %make-outline))
+(define-structure (outline
+                  (constructor %make-outline)
+                  (print-procedure
+                   (unparser/standard-method 'OUTLINE
+                     (lambda (state outline)
+                       (unparse-string state "index: ")
+                       (unparse-object state (outline-index-length outline))
+                       (unparse-string state " y: ")
+                       (unparse-object state (outline-y-size outline))))))
   ;; The number of characters in the text line.  This is exclusive of
   ;; the newlines at the line's beginning and end, if any.
   index-length
@@ -528,8 +536,10 @@
                        (unparse-object state (o3-index o3))
                        (unparse-string state " y: ")
                        (unparse-object state (o3-y o3))
-                       (unparse-string state " ")
-                       (unparse-object state (o3-outline o3))))))
+                       (if (outline? (o3-outline o3))
+                           (begin
+                             (unparse-string state " ")
+                             (unparse-object state (o3-outline o3))))))))
   outline
   index
   y)
@@ -558,14 +568,10 @@
   (group-display-end (%window-group window)))
 
 (define-integrable (%window-group-start-index window)
-  (group-position->index-integrable
-   (%window-group window)
-   (mark-position (group-display-start (%window-group window)))))
+  (mark-index (%window-group-start-mark window)))
 
 (define-integrable (%window-group-end-index window)
-  (group-position->index-integrable
-   (%window-group window)
-   (mark-position (group-display-end (%window-group window)))))
+  (mark-index (%window-group-end-mark window)))
 
 (define-integrable (%window-group-start-index? window index)
   (fix:<= index (%window-group-start-index window)))
@@ -936,8 +942,7 @@
   (if (fix:= y-start 0)
       (if (%window-start-line-mark window)
          (begin
-           (set-mark-index-integrable! (%window-start-line-mark window)
-                                       start-line)
+           (set-mark-index! (%window-start-line-mark window) start-line)
            (if (not (eq? (%window-start-line-mark window)
                          (%window-start-mark window)))
                (begin
@@ -945,30 +950,28 @@
                  (%set-window-start-mark! window
                                           (%window-start-line-mark window)))))
          (let ((mark
-                (%make-permanent-mark (%window-group window)
-                                      start-line
-                                      false)))
+                (make-permanent-mark (%window-group window)
+                                     start-line
+                                     false)))
            (%set-window-start-line-mark! window mark)
            (%set-window-start-mark! window mark)))
       (let ((start (predict-start-index window start-line y-start)))
        (if (%window-start-line-mark window)
            (begin
-             (set-mark-index-integrable! (%window-start-line-mark window)
-                                         start-line)
+             (set-mark-index! (%window-start-line-mark window) start-line)
              (if (eq? (%window-start-line-mark window)
                       (%window-start-mark window))
                  (%set-window-start-mark!
                   window
-                  (%make-permanent-mark (%window-group window) start false))
-                 (set-mark-index-integrable! (%window-start-mark window)
-                                             start)))
+                  (make-permanent-mark (%window-group window) start false))
+                 (set-mark-index! (%window-start-mark window) start)))
            (let ((group (%window-group window)))
              (%set-window-start-line-mark!
               window
-              (%make-permanent-mark group start-line false))
+              (make-permanent-mark group start-line false))
              (%set-window-start-mark!
               window
-              (%make-permanent-mark group start false))))))
+              (make-permanent-mark group start false))))))
   (%set-window-start-line-y! window y-start)
   (if (eq? (%window-point-moved? window) 'SINCE-START-SET)
       (%set-window-point-moved?! window true))
@@ -1119,17 +1122,15 @@ This number is a percentage, where 0 is the window's top and 100 the bottom."
   (%set-window-end-outline! window (o3-outline end))
   (if (%window-current-start-mark window)
       (begin
-       (set-mark-index-integrable! (%window-current-start-mark window)
-                                   (o3-index start))
-       (set-mark-index-integrable! (%window-current-end-mark window)
-                                   (o3-index end)))
+       (set-mark-index! (%window-current-start-mark window) (o3-index start))
+       (set-mark-index! (%window-current-end-mark window) (o3-index end)))
       (begin
        (%set-window-current-start-mark!
         window
-        (%make-permanent-mark (%window-group window) (o3-index start) false))
+        (make-permanent-mark (%window-group window) (o3-index start) false))
        (%set-window-current-end-mark!
         window
-        (%make-permanent-mark (%window-group window) (o3-index end) true))))
+        (make-permanent-mark (%window-group window) (o3-index end) true))))
   (%set-window-current-start-y! window (o3-y start))
   (%set-window-current-end-y! window (o3-y end))
   (deallocate-o3! window start)

diff --git a/v7/src/edwin/bufwiu.scm b/v7/src/edwin/bufwiu.scm
index 3c7150e2ae241d3df7b7d5c578d00c86a424d466..066f5b4e379345f6d5f459c0fff834d54ea88271 100644 (file)
--- a/v7/src/edwin/bufwiu.scm
+++ b/v7/src/edwin/bufwiu.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwiu.scm,v 1.18 1991/04/01 19:47:25 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwiu.scm,v 1.19 1991/04/02 19:55:27 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -61,32 +61,21 @@
     (if (and (not (%window-force-redraw? window))
             (fix:<= (%window-current-start-index window) end)
             (fix:<= start (%window-current-end-index window)))
-       ;; We can compare marks by their positions here because
-       ;; the marks being compared have the same
-       ;; LEFT-INSERTING? flag.
-       (let ((start
-              (group-index->position-integrable group start false))
-             (end (group-index->position-integrable group end true)))
+       (begin
          (if (not (%window-start-changes-mark window))
              (begin
                (%set-window-start-changes-mark!
                 window
-                (%%make-permanent-mark group start false))
+                (make-permanent-mark group start false))
                (%set-window-end-changes-mark!
                 window
-                (%%make-permanent-mark group end true)))
+                (make-permanent-mark group end true)))
              (begin
-               (if (fix:< start
-                          (mark-position
-                           (%window-start-changes-mark window)))
-                   (set-mark-position!
-                    (%window-start-changes-mark window)
-                    start))
-               (if (fix:> end
-                          (mark-position
-                           (%window-end-changes-mark window)))
-                   (set-mark-position! (%window-end-changes-mark window)
-                                       end))))
+               (if (fix:< start (%window-start-changes-index window))
+                   (set-mark-index! (%window-start-changes-mark window)
+                                    start))
+               (if (fix:> end (%window-end-changes-index window))
+                   (set-mark-index! (%window-end-changes-mark window) end))))
          (window-needs-redisplay! window)))
     ;; If this change affects where the window starts, choose a
     ;; new place to start it.
@@ -101,11 +90,9 @@
              (begin
                (clear-start-mark! window)
                (window-needs-redisplay! window)))
-         (if (and (not (eq? (%window-point-moved? window)
-                            'SINCE-START-SET))
-                  (let ((point (%window-point-index window)))
-                    (and (fix:<= start point)
-                         (fix:<= point end))))
+         (if (and (not (eq? (%window-point-moved? window) 'SINCE-START-SET))
+                  (fix:<= start (%window-point-index window))
+                  (fix:<= (%window-point-index window) end))
              (%set-window-point-moved?! window 'SINCE-START-SET))))))
 \f
 ;;;; Clip
@@ -124,22 +111,19 @@
              (begin
                (%set-window-start-clip-mark!
                 window
-                (%make-permanent-mark group
-                                      (group-display-start-index group)
-                                      true))
+                (make-permanent-mark group
+                                     (group-display-start-index group)
+                                     true))
                (%set-window-end-clip-mark!
                 window
-                (%make-permanent-mark group
-                                      (group-display-end-index group)
-                                      false))))
-         (let ((start (group-index->position-integrable group start true))
-               (end (group-index->position-integrable group end false)))
-           ;; We can compare marks by their positions here because the
-           ;; marks being compared have the same LEFT-INSERTING? flag.
-           (if (fix:> start (mark-position (%window-start-clip-mark window)))
-               (set-mark-position! (%window-start-clip-mark window) start))
-           (if (fix:< end (mark-position (%window-end-clip-mark window)))
-               (set-mark-position! (%window-end-clip-mark window) end)))
+                (make-permanent-mark group
+                                     (group-display-end-index group)
+                                     false))))
+         (begin
+           (if (fix:> start (%window-start-clip-index window))
+               (set-mark-index! (%window-start-clip-mark window) start))
+           (if (fix:< end (%window-end-clip-index window))
+               (set-mark-index! (%window-end-clip-mark window) end)))
          (if (and (not (window-needs-redisplay? window))
                   (or (fix:>= (%window-start-clip-index window)
                               (%window-current-start-index window))

diff --git a/v7/src/edwin/bufwmc.scm b/v7/src/edwin/bufwmc.scm
index 05fdbad78996e9e70cdf45d6d63f50af3425df52..646a71d1f58341f957bd4f2dc3c47582972b2db4 100644 (file)
--- a/v7/src/edwin/bufwmc.scm
+++ b/v7/src/edwin/bufwmc.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwmc.scm,v 1.12 1991/04/01 10:06:50 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwmc.scm,v 1.13 1991/04/02 19:55:33 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -176,8 +176,8 @@
        (not (%window-point-moved? window))
        (not (%window-force-redraw? window))
        (%window-start-line-mark window)
-       (fix:= (mark-position (%window-start-line-mark window))
-             (mark-position (%window-current-start-mark window)))))
+       (fix:= (%window-start-line-index window)
+             (%window-current-start-index window))))
 \f
 (define (predict-y window start y index)
   ;; Assuming that the character at index START appears at coordinate

diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index 42561bf9496c4e61b6393041300a4e997de051a1..7779a7ca0413586d41187fed02a179279bf8bd0f 100644 (file)
--- a/v7/src/edwin/fileio.scm
+++ b/v7/src/edwin/fileio.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.93 1991/03/22 00:31:46 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.94 1991/04/02 19:55:39 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -107,6 +107,13 @@
                           (+ index length))))
        (without-interrupts
         (lambda ()
+          (for-each-mark group
+            (lambda (mark)
+              (let ((index* (mark-index mark)))
+                (if (or (fix:> index* index)
+                        (and (fix:= index* index)
+                             (mark-left-inserting? mark)))
+                    (set-mark-index! mark (fix:+ index* n))))))
           (vector-set! group
                        group-index:gap-length
                        (fix:- (group-gap-length group) n))

diff --git a/v7/src/edwin/grpops.scm b/v7/src/edwin/grpops.scm
index 69bffa274c937ef37aade25c0c41fd4a5f117c4a..849502ed31b471d144637e51844297b36df66b40 100644 (file)
--- a/v7/src/edwin/grpops.scm
+++ b/v7/src/edwin/grpops.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/grpops.scm,v 1.8 1991/03/22 00:24:02 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/grpops.scm,v 1.9 1991/04/02 19:55:46 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -60,6 +60,8 @@
 ;;; operations.  It must be at least `gap-allocation-extra'.
 (define gap-maximum-extra 20000)
 
+;;;; Extractions
+
 (define (group-extract-string group start end)
   (let ((text (group-text group))
        (gap-start (group-gap-start group))
@@ -83,10 +85,13 @@
 
 (define (group-left-char group index)
   (string-ref (group-text group)
-             (fix:-1+ (group-index->position group index false))))
+             (fix:-1+ (group-index->position-integrable group index false))))
 
 (define (group-right-char group index)
-  (string-ref (group-text group) (group-index->position group index true)))
+  (string-ref (group-text group)
+             (group-index->position-integrable group index true)))
+\f
+;;;; Insertions
 
 (define (group-insert-char! group index char)
   (without-interrupts
@@ -99,6 +104,13 @@
   (move-gap-to! group index)
   (guarantee-gap-length! group 1)
   (string-set! (group-text group) index char)
+  (for-each-mark group
+    (lambda (mark)
+      (let ((index* (mark-index mark)))
+       (if (or (fix:> index* index)
+               (and (fix:= index* index)
+                    (mark-left-inserting? mark)))
+           (set-mark-index! mark (fix:+ index* 1))))))
   (vector-set! group group-index:gap-length (fix:-1+ (group-gap-length group)))
   (let ((gap-start* (fix:1+ index)))
     (vector-set! group group-index:gap-start gap-start*)
@@ -119,6 +131,13 @@
   (let ((n (fix:- end start)))
     (guarantee-gap-length! group n)
     (substring-move-right! string start end (group-text group) index)
+    (for-each-mark group
+      (lambda (mark)
+       (let ((index* (mark-index mark)))
+         (if (or (fix:> index* index)
+                 (and (fix:= index* index)
+                      (mark-left-inserting? mark)))
+             (set-mark-index! mark (fix:+ index* n))))))
     (vector-set! group
                 group-index:gap-length
                 (fix:- (group-gap-length group) n))
@@ -126,6 +145,8 @@
       (vector-set! group group-index:gap-start gap-start*)
       (undo-record-insertion! group index gap-start*))))
 \f
+;;;; Deletions
+
 (define (group-delete-left-char! group index)
   (group-delete! group (fix:-1+ index) index))
 
@@ -144,46 +165,31 @@
                   ((fix:> gap-start end) (move-gap-to-left! group end))))
           (undo-record-deletion! group start end)
           (record-deletion! group start end)
-          (let* ((end (fix:+ end (group-gap-length group)))
-                 (length (fix:- end start))
-                 (max-length gap-maximum-extra))
-            (if (fix:> length max-length)
-                (let* ((new-end (fix:+ start max-length))
-                       (difference (fix:- length max-length))
+          (let ((length (fix:- end start)))
+            (for-each-mark group
+              (lambda (mark)
+                (let ((index (mark-index mark)))
+                  (if (fix:>= index end)
+                      (set-mark-index! mark (fix:- index length)))))))
+          (vector-set! group group-index:gap-start start)
+          (let ((gap-end (fix:+ end (group-gap-length group)))
+                (max-gap-length gap-maximum-extra))
+            (if (fix:> (fix:- gap-end start) max-gap-length)
+                (let* ((new-gap-end (fix:+ start max-gap-length))
                        (text (group-text group))
-                       (end* (string-length text))
-                       (new-end* (fix:- end* difference)))
-                  (substring-move-left! text end end* text new-end)
-                  (set-string-maximum-length! text new-end*)
-                  (for-each-mark group
-                    (lambda (mark)
-                      (let ((position (mark-position mark)))
-                        (cond ((fix:> position end)
-                               (set-mark-position!
-                                mark
-                                (fix:- position difference)))
-                              ((not (fix:> start position))
-                               (set-mark-position!
-                                mark
-                                (if (mark-left-inserting? mark)
-                                    new-end
-                                    start)))))))
-                  (vector-set! group group-index:gap-start start)
-                  (vector-set! group group-index:gap-end new-end)
-                  (vector-set! group group-index:gap-length max-length))
+                       (text-end (string-length text))
+                       (new-text-end
+                        (fix:- text-end
+                               (fix:- (fix:- gap-end start) max-gap-length))))
+                  (substring-move-left! text gap-end text-end
+                                        text new-gap-end)
+                  (set-string-maximum-length! text new-text-end)
+                  (vector-set! group group-index:gap-end new-gap-end)
+                  (vector-set! group group-index:gap-length max-gap-length))
                 (begin
-                  (for-each-mark group
-                    (lambda (mark)
-                      (let ((position (mark-position mark)))
-                        (if (and (not (fix:> start position))
-                                 (not (fix:> position end)))
-                            (set-mark-position!
-                             mark
-                             (if (mark-left-inserting? mark) end start))))))
-                  (vector-set! group group-index:gap-start start)
-                  (vector-set! group group-index:gap-end end)
-                  (vector-set! group group-index:gap-length length))))
-            unspecific)))))
+                  (vector-set! group group-index:gap-end gap-end)
+                  (vector-set! group group-index:gap-length
+                               (fix:- gap-end start))))))))))
 \f
 ;;;; The Gap
 
@@ -197,19 +203,9 @@
        (length (group-gap-length group))
        (text (group-text group)))
     (let ((new-end (fix:+ new-start length)))
-      (for-each-mark group
-       (lambda (mark)
-         (let ((position (mark-position mark)))
-           (cond ((and (fix:< new-start position)
-                       (not (fix:> position start)))
-                  (set-mark-position! mark (fix:+ position length)))
-                 ((and (mark-left-inserting? mark)
-                       (fix:= new-start position))
-                  (set-mark-position! mark new-end))))))
       (substring-move-right! text new-start start text new-end)
       (vector-set! group group-index:gap-start new-start)
-      (vector-set! group group-index:gap-end new-end)
-      unspecific)))
+      (vector-set! group group-index:gap-end new-end))))
 
 (define (move-gap-to-right! group new-start)
   (let ((start (group-gap-start group))
@@ -217,23 +213,15 @@
        (length (group-gap-length group))
        (text (group-text group)))
     (let ((new-end (fix:+ new-start length)))
-      (for-each-mark group
-       (lambda (mark)
-         (let ((position (mark-position mark)))
-           (cond ((and (fix:> new-end position)
-                       (not (fix:< position end)))
-                  (set-mark-position! mark (fix:- position length)))
-                 ((and (not (mark-left-inserting? mark))
-                       (fix:= new-end position))
-                  (set-mark-position! mark new-start))))))
       (substring-move-left! text end new-end text start)
       (vector-set! group group-index:gap-start new-start)
-      (vector-set! group group-index:gap-end new-end)
-      unspecific)))
+      (vector-set! group group-index:gap-end new-end))))
 
 (define (guarantee-gap-length! group n)
   (if (fix:< (group-gap-length group) n)
-      (let ((n (fix:+ n gap-allocation-extra))
+      (let ((n
+            (fix:+ (fix:- n (group-gap-length group))
+                   gap-allocation-extra))
            (text (group-text group))
            (start (group-gap-start group))
            (end (group-gap-end group))
@@ -244,20 +232,5 @@
            (substring-move-right! text 0 start text* 0)
            (substring-move-right! text end end* text* new-end)
            (vector-set! group group-index:text text*)
-           (vector-set! group group-index:gap-end new-end)
-           (for-each-mark group
-             (if (fix:zero? length)
-                 (lambda (mark)
-                   (let ((position (mark-position mark)))
-                     (if (not (fix:< position end))
-                         (set-mark-position!
-                          mark
-                          (cond ((fix:> position end) (fix:+ position n))
-                                ((mark-left-inserting? mark) new-end)
-                                (else start))))))
-                 (lambda (mark)
-                   (let ((position (mark-position mark)))
-                     (if (not (fix:< position end))
-                         (set-mark-position! mark (fix:+ position n)))))))))
-       (vector-set! group group-index:gap-length (fix:+ length n))
-       unspecific)))
\ No newline at end of file
+           (vector-set! group group-index:gap-end new-end)))
+       (vector-set! group group-index:gap-length (fix:+ length n)))))
\ No newline at end of file

diff --git a/v7/src/edwin/regops.scm b/v7/src/edwin/regops.scm
index 1d233b77ca96e51e57dd591cc9fc9964958b9312..e5b6fca317e296f68803365245f65226a14698e9 100644 (file)
--- a/v7/src/edwin/regops.scm
+++ b/v7/src/edwin/regops.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regops.scm,v 1.81 1991/03/22 00:32:43 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regops.scm,v 1.82 1991/04/02 19:55:52 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -52,8 +52,8 @@
        (start (mark-index mark)))
     (let ((n (string-length string)))
       (group-insert-substring! group start string 0 n)
-      (%make-region (%make-temporary-mark group start false)
-                   (%make-temporary-mark group (+ start n) true)))))
+      (%make-region (make-temporary-mark group start false)
+                   (make-temporary-mark group (+ start n) true)))))
 
 (define (region-insert-string! mark string)
   (group-insert-substring! (mark-group mark) (mark-index mark)
@@ -123,8 +123,8 @@
   unspecific)
 
 (define (group-un-clip! group)
-  (let ((start (%make-permanent-mark group 0 false))
-       (end (%make-permanent-mark group (group-length group) true)))
+  (let ((start (make-permanent-mark group 0 false))
+       (end (make-permanent-mark group (group-length group) true)))
     (record-clipping! group 0 (group-length group))
     (vector-set! group group-index:start-mark start)
     (vector-set! group group-index:end-mark end)

diff --git a/v7/src/edwin/struct.scm b/v7/src/edwin/struct.scm
index d27a12048024f7f820386a4e578cd63633800fa0..f14f861c130b7242f4d6c7c1fd90b26218dbe559 100644 (file)
--- a/v7/src/edwin/struct.scm
+++ b/v7/src/edwin/struct.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/struct.scm,v 1.75 1991/04/01 10:04:29 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/struct.scm,v 1.76 1991/04/02 19:56:05 cph Exp $
 ;;;
 ;;;    Copyright (c) 1985, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -87,6 +87,8 @@
 ;;;; Groups
 
 (define-named-structure "Group"
+  ;; The microcode file "edwin.h" depends on the fields TEXT,
+  ;; GAP-START, GAP-LENGTH, GAP-END, START-MARK, and END-MARK.
   text
   gap-start
   gap-length
@@ -114,10 +116,10 @@
     (vector-set! group group-index:gap-length 0)
     (vector-set! group group-index:gap-end n)
     (vector-set! group group-index:marks '())
-    (let ((start (%make-permanent-mark group 0 false)))
+    (let ((start (make-permanent-mark group 0 false)))
       (vector-set! group group-index:start-mark start)
       (vector-set! group group-index:display-start start))
-    (let ((end (%make-permanent-mark group n true)))
+    (let ((end (make-permanent-mark group n true)))
       (vector-set! group group-index:end-mark end)
       (vector-set! group group-index:display-end end))
     (vector-set! group group-index:read-only? false)
@@ -126,7 +128,7 @@
     (vector-set! group group-index:clip-daemons '())
     (vector-set! group group-index:undo-data false)
     (vector-set! group group-index:modified? false)
-    (vector-set! group group-index:point (%make-permanent-mark group 0 true))
+    (vector-set! group group-index:point (make-permanent-mark group 0 true))
     (vector-set! group group-index:buffer buffer)
     group))
 
@@ -212,8 +214,8 @@
 (define (with-group-text-clipped! group start end thunk)
   (let ((old-text-start)
        (old-text-end)
-       (new-text-start (%make-permanent-mark group start false))
-       (new-text-end (%make-permanent-mark group end true)))
+       (new-text-start (make-permanent-mark group start false))
+       (new-text-end (make-permanent-mark group end true)))
     (dynamic-wind (lambda ()
                    (set! old-text-start (group-start-mark group))
                    (set! old-text-end (group-end-mark group))
@@ -286,20 +288,23 @@
 ;;;; Marks
 
 (define-structure (mark
-                  (constructor %make-mark)
+                  (constructor make-temporary-mark)
                   (print-procedure
                    (unparser/standard-method 'MARK
                      (lambda (state mark)
-                       (unparse-string state "index: ")
+                       (unparse-object state
+                                       (or (mark-buffer mark)
+                                           (mark-group mark)))
+                       (unparse-string state " ")
                        (unparse-object state (mark-index mark))
-                       (unparse-string state " position: ")
-                       (unparse-object state (mark-position mark))
                        (unparse-string state
                                        (if (mark-left-inserting? mark)
                                            " left"
                                            " right"))))))
+  ;; The microcode file "edwin.h" depends on the definition of this
+  ;; structure.
   (group false read-only true)
-  (position false)
+  (index false)
   (left-inserting? false read-only true))
 
 (define (guarantee-mark mark)
@@ -307,39 +312,51 @@
   mark)
 
 (define-integrable (make-mark group index)
-  (%make-temporary-mark group index true))
+  (make-temporary-mark group index true))
 
-(define (%make-temporary-mark group index left-inserting?)
-  (%make-mark group
-             (group-index->position-integrable group index left-inserting?)
-             left-inserting?))
+(define (move-mark-to! mark target)
+  (set-mark-index! mark (mark-index target)))
 
-(define (mark-index mark)
-  (mark-index-integrable mark))
+(define (mark-temporary-copy mark)
+  (make-temporary-mark (mark-group mark)
+                      (mark-index mark)
+                      (mark-left-inserting? mark)))
 
-(define-integrable (mark-index-integrable mark)
-  (group-position->index-integrable (mark-group mark) (mark-position mark)))
+(define-integrable (mark-permanent-copy mark)
+  (mark-permanent! (mark-temporary-copy mark)))
 
-(define (set-mark-index! mark index)
-  (set-mark-index-integrable! mark index))
+(define (mark-right-inserting mark)
+  (if (mark-left-inserting? mark)
+      (make-permanent-mark (mark-group mark) (mark-index mark) false)
+      (mark-permanent! mark)))
 
-(define-integrable (set-mark-index-integrable! mark index)
-  (set-mark-position!
-   mark
-   (group-index->position-integrable (mark-group mark)
-                                    index
-                                    (mark-left-inserting? mark))))
+(define (mark-right-inserting-copy mark)
+  (make-permanent-mark (mark-group mark) (mark-index mark) false))
 
-(define (move-mark-to! mark target)
-  (set-mark-index-integrable! mark (mark-index-integrable target)))
+(define (mark-left-inserting mark)
+  (if (mark-left-inserting? mark)
+      (mark-permanent! mark)
+      (make-permanent-mark (mark-group mark) (mark-index mark) true)))
 
-(define (mark-temporary-copy mark)
-  (%make-mark (mark-group mark)
-             (mark-position mark)
-             (mark-left-inserting? mark)))
+(define (mark-left-inserting-copy mark)
+  (make-permanent-mark (mark-group mark) (mark-index mark) true))
 
-(define-integrable (mark-permanent-copy mark)
-  (mark-permanent! (mark-temporary-copy mark)))
+(define (make-permanent-mark group index left-inserting?)
+  (let ((mark (make-temporary-mark group index left-inserting?)))
+    (set-group-marks! group
+                     (system-pair-cons (ucode-type weak-cons)
+                                       mark
+                                       (group-marks group)))
+    mark))
+
+(define (mark-permanent! mark)
+  (let ((group (mark-group mark)))
+    (if (not (weak-memq mark (group-marks group)))
+       (set-group-marks! group
+                         (system-pair-cons (ucode-type weak-cons)
+                                           mark
+                                           (group-marks group)))))
+  mark)
 \f
 (define-integrable (mark~ mark1 mark2)
   (eq? (mark-group mark1) (mark-group mark2)))
@@ -392,74 +409,6 @@
 (define (group-display-end? mark)
   (group-display-end-index? (mark-group mark) (mark-index mark)))
 \f
-(define (mark-right-inserting mark)
-  (if (mark-left-inserting? mark)
-      (let ((group (mark-group mark)))
-       (%%make-permanent-mark group
-                              (if (fix:= (mark-position mark)
-                                         (group-gap-end group))
-                                  (group-gap-start group)
-                                  (mark-position mark))
-                              false))
-      (mark-permanent! mark)))
-
-(define (mark-right-inserting-copy mark)
-  (let ((group (mark-group mark)))
-    (%%make-permanent-mark group
-                          (if (and (mark-left-inserting? mark)
-                                   (fix:= (mark-position mark)
-                                          (group-gap-end group)))
-                              (group-gap-start group)
-                              (mark-position mark))
-                          false)))
-
-(define (mark-left-inserting mark)
-  (if (mark-left-inserting? mark)
-      (mark-permanent! mark)
-      (let ((group (mark-group mark)))
-       (%%make-permanent-mark group
-                              (if (fix:= (mark-position mark)
-                                         (group-gap-start group))
-                                  (group-gap-end group)
-                                  (mark-position mark))
-                              true))))
-
-(define (mark-left-inserting-copy mark)
-  (let ((group (mark-group mark)))
-    (%%make-permanent-mark group
-                          (if (and (not (mark-left-inserting? mark))
-                                   (fix:= (mark-position mark)
-                                          (group-gap-start group)))
-                              (group-gap-end group)
-                              (mark-position mark))
-                          true)))
-
-(define-integrable (%make-permanent-mark group index left-inserting?)
-  (%%make-permanent-mark
-   group
-   (group-index->position-integrable group index left-inserting?)
-   left-inserting?))
-
-(define (%%make-permanent-mark group position left-inserting?)
-  (let ((mark (%make-mark group position left-inserting?)))
-    (set-group-marks! group
-                     (system-pair-cons (ucode-type weak-cons)
-                                       mark
-                                       (group-marks group)))
-    mark))
-
-(define (mark-permanent! mark)
-  (let ((group (mark-group mark)))
-    (or (let ((tail (weak-memq mark (group-marks group))))
-         (and tail
-              (system-pair-car tail)))
-       (begin
-         (set-group-marks! group
-                           (system-pair-cons (ucode-type weak-cons)
-                                             mark
-                                             (group-marks group)))
-         mark))))
-\f
 ;;; The next few procedures are simple algorithms that are haired up
 ;;; the wazoo for maximum speed.
 
@@ -547,7 +496,7 @@
                  (else
                   (scan-tail marks (system-pair-cdr marks)))))))))
 \f
-(define (find-permanent-mark group position left-inserting?)
+(define (find-permanent-mark group index left-inserting?)
 
   (define (scan-head marks)
     (if (null? marks)
@@ -560,7 +509,7 @@
                ((and (if (mark-left-inserting? mark)
                          left-inserting?
                          (not left-inserting?))
-                     (fix:= (mark-position mark) position))
+                     (fix:= (mark-index mark) index))
                 mark)
                (else
                 (set-group-marks! group marks)
@@ -574,7 +523,7 @@
                 ((and (if (mark-left-inserting? mark)
                           left-inserting?
                           (not left-inserting?))
-                      (fix:= (mark-position mark) position))
+                      (fix:= (mark-index mark) index))
                  mark)
                 (else
                  (scan-tail marks (system-pair-cdr marks)))))))
@@ -592,7 +541,7 @@
                (if (and (if (mark-left-inserting? mark)
                             left-inserting?
                             (not left-inserting?))
-                        (fix:= (mark-position mark) position))
+                        (fix:= (mark-index mark) index))
                    mark
                    (scan-tail marks (system-pair-cdr marks))))))))
 
@@ -604,7 +553,7 @@
                 ((and (if (mark-left-inserting? mark)
                           left-inserting?
                           (not left-inserting?))
-                      (fix:= (mark-position mark) position))
+                      (fix:= (mark-index mark) index))
                  mark)
                 (else
                  (scan-tail marks (system-pair-cdr marks))))))))
@@ -662,15 +611,12 @@
 (define-integrable region-end cdr)
 
 (define (make-region start end)
-  (let ((group (mark-group start))
-       (start-position (mark-position start))
-       (end-position (mark-position end)))
-    (cond ((not (eq? group (mark-group end)))
-          (error "Marks not related" start end))
-         ((not (fix:> start-position end-position))
-          (%make-region start end))
-         (else
-          (%make-region end start)))))
+  (cond ((not (eq? (mark-group start) (mark-group end)))
+        (error "Marks not related" start end))
+       ((fix:<= (mark-index start) (mark-index end))
+        (%make-region start end))
+       (else
+        (%make-region end start))))
 
 (define-integrable (region-group region)
   (mark-group (region-start region)))