Fix highlighting bug in SCREEN-GET-OUTPUT-LINE.
authorJason Wilson <edu/mit/csail/zurich/jawilson>
Fri, 13 Aug 1993 01:35:02 +0000 (01:35 +0000)
committerJason Wilson <edu/mit/csail/zurich/jawilson>
Fri, 13 Aug 1993 01:35:02 +0000 (01:35 +0000)
v7/src/edwin/screen.scm

index d4ca39093caa21db3af02179036c6b517d3b7c29..c5e29009b28cf26714f18799f1451b7db15d6b84 100644 (file)
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.101 1992/09/08 18:18:03 cph Exp $
+;;;    $Id: screen.scm,v 1.102 1993/08/13 01:35:02 jawilson Exp $
 ;;;
-;;;    Copyright (c) 1989-92 Massachusetts Institute of Technology
+;;;    Copyright (c) 1989-93 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
       ((screen-debug-trace screen) 'screen screen 'output-char
                                   x y char highlight))
   (let ((new-matrix (screen-new-matrix screen)))
-    (if (not (boolean-vector-ref (matrix-enable new-matrix) y))
-       (begin
-         (boolean-vector-set! (matrix-enable new-matrix) y true)
-         (set-screen-needs-update?! screen true)
-         (initialize-new-line-contents screen y)))
-    (string-set! (vector-ref (matrix-contents new-matrix) y) x char)
-    (cond ((boolean-vector-ref (matrix-highlight-enable new-matrix) y)
+    (cond ((not (boolean-vector-ref (matrix-enable new-matrix) y))
+          (boolean-vector-set! (matrix-enable new-matrix) y true)
+          (set-screen-needs-update?! screen true)
+          (initialize-new-line-contents screen y)
+          (if highlight
+              (begin
+                (boolean-vector-set! (matrix-highlight-enable new-matrix) y true)
+                (initialize-new-line-highlight screen y)
+                (boolean-vector-set! (vector-ref (matrix-highlight new-matrix) y)
+                                     x highlight))))
+         ((boolean-vector-ref (matrix-highlight-enable new-matrix) y)
           (boolean-vector-set! (vector-ref (matrix-highlight new-matrix) y)
                                x highlight))
          (highlight
           (boolean-vector-set! (matrix-highlight-enable new-matrix) y true)
-          (initialize-new-line-highlight screen y)
+          (boolean-vector-fill! (vector-ref (matrix-highlight new-matrix) y)
+                                false)
           (boolean-vector-set! (vector-ref (matrix-highlight new-matrix) y)
-                               x highlight)))))
-
-(define (screen-output-substring screen x y string start end highlight)
-  (substring-move-left! string start end
-                       (screen-get-output-line screen y x
-                                               (fix:+ x (fix:- end start))
-                                               highlight)
-                       x))
+                               x highlight)))
+    (string-set! (vector-ref (matrix-contents new-matrix) y) x char)))
 
 (define (screen-get-output-line screen y xl xu highlight)
   (if (screen-debug-trace screen)
                                   y xl xu highlight))
   (let ((new-matrix (screen-new-matrix screen)))
     (let ((full-line? (and (fix:= xl 0) (fix:= xu (screen-x-size screen)))))
-      (if (not (boolean-vector-ref (matrix-enable new-matrix) y))
-         (begin
-           (boolean-vector-set! (matrix-enable new-matrix) y true)
-           (set-screen-needs-update?! screen true)
-           (if (not full-line?) (initialize-new-line-contents screen y))))
-      (cond ((boolean-vector-ref (matrix-highlight-enable new-matrix) y)
+      (cond ((not (boolean-vector-ref (matrix-enable new-matrix) y))
+            (boolean-vector-set! (matrix-enable new-matrix) y true)
+            (set-screen-needs-update?! screen true)
+            (if (not full-line?) (initialize-new-line-contents screen y))
+            (if highlight
+                (begin
+                  (boolean-vector-set! (matrix-highlight-enable new-matrix)
+                                       y true)
+                  (if (not full-line?)
+                      (initialize-new-line-highlight screen y))
+                  (boolean-subvector-fill!
+                   (vector-ref (matrix-highlight new-matrix) y)
+                   xl xu highlight))))
+           ((boolean-vector-ref (matrix-highlight-enable new-matrix) y)
             (if (and full-line? (not highlight))
                 (boolean-vector-set! (matrix-highlight-enable new-matrix)
                                      y false)
                  xl xu highlight)))
            (highlight
             (boolean-vector-set! (matrix-highlight-enable new-matrix) y true)
-            (if (not full-line?) (initialize-new-line-highlight screen y))
+            (if (not full-line?)
+                (boolean-vector-fill!
+                 (vector-ref (matrix-highlight new-matrix) y)
+                 false))
             (boolean-subvector-fill!
              (vector-ref (matrix-highlight new-matrix) y)
              xl xu highlight))))
     (vector-ref (matrix-contents new-matrix) y)))
+\f
+(define (screen-output-substring screen x y string start end highlight)
+  (substring-move-left! string start end
+                       (screen-get-output-line screen y x
+                                               (fix:+ x (fix:- end start))
+                                               highlight)
+                       x))
 
 (define-integrable (initialize-new-line-contents screen y)
   (if (boolean-vector-ref (matrix-enable (screen-current-matrix screen)) y)