Fix bug in which CLEAR-RECTANGLE would erase the highlighting on mode
authorChris Hanson <org/chris-hanson/cph>
Tue, 9 Jul 1991 22:52:18 +0000 (22:52 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 9 Jul 1991 22:52:18 +0000 (22:52 +0000)
lines that were not full-screen width.

v7/src/edwin/screen.scm

index c05e4009b0bc5a2ebcf1d30c40b2cc66bf2833b5..086b53efde4f96e3c544a0b2f9b3487b41786dd4 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.93 1991/04/21 00:38:30 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.94 1991/07/09 22:52:18 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-91 Massachusetts Institute of Technology
 ;;;
                         (highlight
                          (boolean-vector-set! new-hl-enable y true)
                          (if (boolean-vector-ref current-hl-enable y)
-                             (boolean-vector-move! current-hl
+                             (boolean-vector-move! (vector-ref current-hl y)
                                                    (vector-ref new-hl y))
                              (boolean-vector-fill! (vector-ref new-hl y)
                                                    false))
                          (boolean-subvector-fill! (vector-ref new-hl y)
-                                                  xl xu highlight)))))))
+                                                  xl xu highlight))
+                        ((boolean-vector-ref current-hl-enable y)
+                         (let ((nhl (vector-ref new-hl y)))
+                           (boolean-vector-move! (vector-ref current-hl y)
+                                                 nhl)
+                           (boolean-subvector-fill! nhl xl xu false)
+                           (if (not (boolean-vector-all-elements? nhl false))
+                               (boolean-vector-set! new-hl-enable y
+                                                    true)))))))))
            (highlight
             (do ((y yl (fix:1+ y)))
                 ((fix:= y yu))