Change data structures and calling conventions of screen abstraction

so that "highlighting" can specify the "face" in which the text will
appear.  This generalization allows us to modify the terminal
abstractions to support multiple fonts and colors.

diff --git a/v7/src/edwin/debug.scm b/v7/src/edwin/debug.scm
index 2ccab442c1824ca58c8909e9f86701500be40894..ea2b96140d8c34964a72c477451ca9f14040233d 100644 (file)
--- a/v7/src/edwin/debug.scm
+++ b/v7/src/edwin/debug.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: debug.scm,v 1.39 1996/11/07 21:57:58 adams Exp $
+;;;    $Id: debug.scm,v 1.40 1997/02/23 06:24:31 cph Exp $
 ;;;
-;;;    Copyright (c) 1992-96 Massachusetts Institute of Technology
+;;;    Copyright (c) 1992-97 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -52,7 +52,7 @@
 (define (with-output-highlighted port thunk)
   (let ((start (mark-temporary-copy (port/mark port))))
     (thunk)
-    (highlight-region (make-region start (port/mark port)) #t)))
+    (highlight-region (make-region start (port/mark port)) (highlight-face))))
 
 (define (read-only-between start end)
   (region-read-only (make-region start end)))
@@ -61,7 +61,7 @@
   (region-writable (make-region start end)))
 
 (define (dehigh-between start end)
-  (highlight-region (make-region start end) #f))
+  (highlight-region (make-region start end) (default-face)))
 
 (define (debugger-pp-highlight-subexpression expression subexpression
                                             indentation port)
@@ -89,7 +89,7 @@
     (if (and start-mark end-mark)
        (highlight-region-excluding-indentation
         (make-region start-mark end-mark)
-        #t))
+        (highlight-face)))
     (if start-mark (mark-temporary! start-mark))
     (if end-mark (mark-temporary! end-mark))))
 \f
@@ -317,7 +317,7 @@
                                   (if (mark? end)
                                       (mark- end 1)
                                       (line-end mark 0)))
-                     #t)))
+                     (highlight-face))))
 
 (define (unselect-bline browser)
   (let ((bline (browser/selected-line browser)))

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index e1239da0a21d6b2350d633de3911364f9ea5fc4e..67530d4b856faaf4667468e053eabac78fada721 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.203 1996/12/19 04:50:07 cph Exp $
+$Id: edwin.pkg,v 1.204 1997/02/23 06:24:34 cph Exp $
 
-Copyright (c) 1989-96 Massachusetts Institute of Technology
+Copyright (c) 1989-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -246,7 +246,10 @@ MIT in each case. |#
   (files "screen")
   (parent (edwin))
   (export (edwin)
+         default-face
+         default-face?
          guarantee-screen
+         highlight-face
          initialize-screen-root-window!
          screen-beep
          screen-clear-rectangle

diff --git a/v7/src/edwin/eystep.scm b/v7/src/edwin/eystep.scm
index 73033b0d60e5c890006b78220d4477f7110fd0af..b01661ffd573f7e9334b4de8fa7936fcc9956888 100644 (file)
--- a/v7/src/edwin/eystep.scm
+++ b/v7/src/edwin/eystep.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: eystep.scm,v 1.3 1996/05/14 01:52:30 cph Exp $
+;;;    $Id: eystep.scm,v 1.4 1997/02/23 06:24:36 cph Exp $
 ;;;
-;;;    Copyright (c) 1994 Massachusetts Institute of Technology
+;;;    Copyright (c) 1994-97 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -259,8 +259,8 @@ c   contract the step under the cursor")
                           (eq? (car last-event) 'CALL)
                           (eq? (cadr last-event) node)
                           (lambda (region)
-                            (highlight-region-excluding-indentation region
-                                                                    #t))))
+                            (highlight-region-excluding-indentation
+                             region (highlight-face)))))
                    (insert-string (if (ynode-hidden-children? node)
                                       " ===> "
                                       " => ")
@@ -282,7 +282,7 @@ c   contract the step under the cursor")
                             (eq? (car last-event) 'RETURN)
                             (eq? (cadr last-event) value-node)
                             (lambda (region)
-                              (highlight-region region #t)))))
+                              (highlight-region region (highlight-face))))))
                    (insert-newline point)
                    (save-ynode-region! regions node start point)
                    (if (not (eq? 'STEP-OVER (ynode-type node)))

diff --git a/v7/src/edwin/info.scm b/v7/src/edwin/info.scm
index 91b845ca62c4a5ea524b1084b135c7d9cafa48e8..01c61a15b135f142474f07000834137eaebddad3 100644 (file)
--- a/v7/src/edwin/info.scm
+++ b/v7/src/edwin/info.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: info.scm,v 1.121 1996/04/24 01:57:30 cph Exp $
+;;;    $Id: info.scm,v 1.122 1997/02/23 06:24:38 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-97 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -844,7 +844,7 @@ The name may be an abbreviation of the reference name."
             (let ((region (locator node)))
               (if region
                   (begin
-                    (if highlight? (highlight-region region #t))
+                    (if highlight? (highlight-region region (highlight-face)))
                     (set-region-local-comtabs! region (comtab command))))))))
       (do-button locate-node-up (ref-command-object info-up))
       (do-button locate-node-previous (ref-command-object info-previous))
@@ -855,7 +855,8 @@ The name may be an abbreviation of the reference name."
            (let ((comtabs
                   (comtab (ref-command-object info-current-menu-item))))
              (lambda (group start end)
-               (if highlight? (highlight-subgroup group start end #t))
+               (if highlight?
+                   (highlight-subgroup group start end (highlight-face)))
                (set-subgroup-local-comtabs! group start end comtabs))))))))
 
 (define (record-node file node point)

diff --git a/v7/src/edwin/screen.scm b/v7/src/edwin/screen.scm
index 65a046e5cc6959fce2a93528397112a0cf083c34..59f5387c92ac326385cbbb353997b960b2580a52 100644 (file)
--- a/v7/src/edwin/screen.scm
+++ b/v7/src/edwin/screen.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: screen.scm,v 1.114 1996/09/28 03:50:38 cph Exp $
+;;;    $Id: screen.scm,v 1.115 1997/02/23 06:24:40 cph Exp $
 ;;;
-;;;    Copyright (c) 1989-96 Massachusetts Institute of Technology
+;;;    Copyright (c) 1989-97 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -218,20 +218,18 @@
                                   x y first-unused-x))
   ((screen-operation/clear-line! screen) screen x y first-unused-x))
 
-(define-integrable (terminal-output-char screen x y char highlight)
+(define-integrable (terminal-output-char screen x y char face)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'terminal screen 'output-char
-                                  x y char highlight))
-  ((screen-operation/write-char! screen) screen x y char highlight))
+                                  x y char face))
+  ((screen-operation/write-char! screen) screen x y char face))
 
-(define-integrable (terminal-output-substring screen x y string start end
-                                             highlight)
+(define-integrable (terminal-output-substring screen x y string start end face)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'terminal screen 'output-substring
-                                  x y (string-copy string) start end
-                                  highlight))
+                                  x y (string-copy string) start end face))
   ((screen-operation/write-substring! screen) screen x y string start end
-                                             highlight))
+                                             face))
 \f
 ;;;; Update Optimization
 
@@ -242,7 +240,7 @@
   contents
 
   ;; Vector of line highlights.
-  ;; (boolean-vector-ref (vector-ref (matrix-highlight m) y) x) is the
+  ;; (vector-ref (vector-ref (matrix-highlight m) y) x) is the
   ;; highlight at position X, Y.
   highlight
 
@@ -269,14 +267,86 @@
       (do ((i 0 (fix:1+ i)))
          ((fix:= i y-size))
        (vector-set! contents i (make-string x-size))
-       (vector-set! highlight i (make-boolean-vector x-size)))
+       (vector-set! highlight i (make-vector x-size)))
       (boolean-vector-fill! enable false)
       (set-matrix-contents! matrix contents)
       (set-matrix-highlight! matrix highlight)
       (set-matrix-enable! matrix enable)
       (set-matrix-highlight-enable! matrix highlight-enable))
     matrix))
+\f
+(define-integrable (highlight-ref matrix y x)
+  (vector-ref (vector-ref (matrix-highlight matrix) y) x))
+
+(define-integrable (highlight-set! matrix y x face)
+  (vector-set! (vector-ref (matrix-highlight matrix) y) x face))
+
+(define-integrable (set-line-highlights! matrix y face)
+  (vector-fill! (vector-ref (matrix-highlight matrix) y) face))
+
+(define-integrable (set-subline-highlights! matrix y xl xu face)
+  (subvector-fill! (vector-ref (matrix-highlight matrix) y) xl xu face))
+
+(define-integrable (clear-line-highlights! matrix y)
+  (set-line-highlights! matrix y (default-face)))
+
+(define-integrable (clear-subline-highlights! matrix y xl xu)
+  (set-subline-highlights! matrix y xl xu (default-face)))
+
+(define-integrable (copy-line-highlights! m1 y1 m2 y2)
+  (vector-move! (vector-ref (matrix-highlight m1) y1)
+               (vector-ref (matrix-highlight m2) y2)))
+
+(define-integrable (copy-subline-highlights! m1 y1 xl1 xu1 m2 y2 xl2)
+  (subvector-move-left! (vector-ref (matrix-highlight m1) y1) xl1 xu1
+                       (vector-ref (matrix-highlight m2) y2) xl2))
+
+(define (line-highlights-cleared? matrix y)
+  (vector-filled? (vector-ref (matrix-highlight matrix) y) (default-face)))
+
+(define (swap-line-highlights! m1 y1 m2 y2)
+  (let ((h (vector-ref (matrix-highlight m1) y1)))
+    (vector-set! (matrix-highlight m1) y1
+                (vector-ref (matrix-highlight m2) y2))
+    (vector-set! (matrix-highlight m2) y2 h)))
+
+(define (subline-highlights-uniform? matrix y xl xu)
+  (subvector-uniform? (vector-ref (matrix-highlight matrix) y) xl xu))
+
+(define (find-subline-highlight-change matrix y xl xu face)
+  (subvector-find-next-element-not (vector-ref (matrix-highlight matrix) y)
+                                  xl xu face))
+
+(define-integrable (default-face? face)
+  (not face))
 
+(define-integrable (default-face)
+  #f)
+
+(define-integrable (highlight-face)
+  #t)
+
+(define-integrable (line-contents-enabled? matrix y)
+  (boolean-vector-ref (matrix-enable matrix) y))
+
+(define-integrable (enable-line-contents! matrix y)
+  (boolean-vector-set! (matrix-enable matrix) y #t))
+
+(define-integrable (disable-line-contents! matrix y)
+  (boolean-vector-set! (matrix-enable matrix) y #f))
+
+(define-integrable (multiple-line-contents-enabled? matrix yl yu)
+  (boolean-subvector-all-elements? (matrix-enable matrix) yl yu #t))
+
+(define-integrable (line-highlights-enabled? matrix y)
+  (boolean-vector-ref (matrix-highlight-enable matrix) y))
+
+(define-integrable (enable-line-highlights! matrix y)
+  (boolean-vector-set! (matrix-highlight-enable matrix) y #t))
+
+(define-integrable (disable-line-highlights! matrix y)
+  (boolean-vector-set! (matrix-highlight-enable matrix) y #f))
+\f
 (define (set-screen-size! screen x-size y-size)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'set-size! x-size y-size))
@@ -313,80 +383,62 @@
     (set-matrix-cursor-x! new-matrix x)
     (set-matrix-cursor-y! new-matrix y)))
 \f
-(define (screen-output-char screen x y char highlight)
+(define (screen-output-char screen x y char face)
   (if (screen-debug-trace screen)
-      ((screen-debug-trace screen) 'screen screen 'output-char
-                                  x y char highlight))
+      ((screen-debug-trace screen) 'screen screen 'output-char x y char face))
   (let ((new-matrix (screen-new-matrix screen)))
-    (cond ((not (boolean-vector-ref (matrix-enable new-matrix) y))
-          (boolean-vector-set! (matrix-enable new-matrix) y true)
+    (cond ((not (line-contents-enabled? new-matrix y))
+          (enable-line-contents! new-matrix y)
           (set-screen-needs-update?! screen true)
           (initialize-new-line-contents screen y)
-          (if highlight
+          (if (not (default-face? face))
               (begin
-                (boolean-vector-set! (matrix-highlight-enable new-matrix)
-                                     y #t)
+                (enable-line-highlights! new-matrix y)
                 (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)
-          (boolean-vector-fill! (vector-ref (matrix-highlight new-matrix) y)
-                                false)
-          (boolean-vector-set! (vector-ref (matrix-highlight new-matrix) y)
-                               x highlight)))
+                (highlight-set! new-matrix y x face))))
+         ((line-highlights-enabled? new-matrix y)
+          (highlight-set! new-matrix y x face))
+         ((not (default-face? face))
+          (enable-line-highlights! new-matrix y)
+          (clear-line-highlights! new-matrix y)
+          (highlight-set! new-matrix y x face)))
     (string-set! (vector-ref (matrix-contents new-matrix) y) x char)))
 
-(define (screen-get-output-line screen y xl xu highlight)
+(define (screen-get-output-line screen y xl xu face)
   (if (screen-debug-trace screen)
-      ((screen-debug-trace screen) 'screen screen 'output-line
-                                  y xl xu highlight))
+      ((screen-debug-trace screen) 'screen screen 'output-line y xl xu face))
   (let ((new-matrix (screen-new-matrix screen)))
     (let ((full-line? (and (fix:= xl 0) (fix:= xu (screen-x-size screen)))))
-      (cond ((not (boolean-vector-ref (matrix-enable new-matrix) y))
-            (boolean-vector-set! (matrix-enable new-matrix) y true)
+      (cond ((not (line-contents-enabled? new-matrix y))
+            (enable-line-contents! new-matrix y)
             (set-screen-needs-update?! screen true)
             (if (not full-line?) (initialize-new-line-contents screen y))
-            (if highlight
+            (if (not (default-face? face))
                 (begin
-                  (boolean-vector-set! (matrix-highlight-enable new-matrix)
-                                       y true)
+                  (enable-line-highlights! new-matrix y)
                   (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)
-                (boolean-subvector-fill!
-                 (vector-ref (matrix-highlight new-matrix) y)
-                 xl xu highlight)))
-           (highlight
-            (boolean-vector-set! (matrix-highlight-enable new-matrix) y true)
+                  (set-subline-highlights! new-matrix y xl xu face))))
+           ((line-highlights-enabled? new-matrix y)
+            (if (and full-line? (not face))
+                (disable-line-highlights! new-matrix y)
+                (set-subline-highlights! new-matrix y xl xu face)))
+           ((not (default-face? face))
+            (enable-line-highlights! new-matrix 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))))
+                (set-line-highlights! new-matrix y (default-face)))
+            (set-subline-highlights! new-matrix y xl xu face))))
     (vector-ref (matrix-contents new-matrix) y)))
 \f
-(define (screen-output-substring screen x y string start end highlight)
+(define (screen-output-substring screen x y string start end face)
   (substring-move-left! string start end
                        (screen-get-output-line screen y x
                                                (fix:+ x (fix:- end start))
-                                               highlight)
+                                               face)
                        x))
 
 (define-integrable (initialize-new-line-contents screen y)
-  (if (boolean-vector-ref (matrix-enable (screen-current-matrix screen)) y)
+  (if (line-contents-enabled? (screen-current-matrix screen) y)
       (string-move!
        (vector-ref (matrix-contents (screen-current-matrix screen)) y)
        (vector-ref (matrix-contents (screen-new-matrix screen)) y))
@@ -395,38 +447,26 @@
        #\space)))
 
 (define-integrable (initialize-new-line-highlight screen y)
-  (if (boolean-vector-ref
-       (matrix-highlight-enable (screen-current-matrix screen))
-       y)
-      (boolean-vector-move!
-       (vector-ref (matrix-highlight (screen-current-matrix screen)) y)
-       (vector-ref (matrix-highlight (screen-new-matrix screen)) y))
-      (boolean-vector-fill!
-       (vector-ref (matrix-highlight (screen-new-matrix screen)) y)
-       false)))
+  (if (line-highlights-enabled? (screen-current-matrix screen) y)
+      (copy-line-highlights! (screen-current-matrix screen) y
+                            (screen-new-matrix screen) y)
+      (clear-line-highlights! (screen-new-matrix screen) y)))
 \f
-(define (screen-clear-rectangle screen xl xu yl yu highlight)
+(define (screen-clear-rectangle screen xl xu yl yu face)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'clear-rectangle
-                                  xl xu yl yu highlight))
+                                  xl xu yl yu face))
   (let ((new-matrix (screen-new-matrix screen)))
-    (let ((new-contents (matrix-contents new-matrix))
-         (new-hl (matrix-highlight new-matrix))
-         (new-enable (matrix-enable new-matrix))
-         (new-hl-enable (matrix-highlight-enable new-matrix)))
+    (let ((new-contents (matrix-contents new-matrix)))
       (cond ((not (and (fix:= xl 0) (fix:= xu (screen-x-size screen))))
             (let ((current-matrix (screen-current-matrix screen)))
-              (let ((current-contents (matrix-contents current-matrix))
-                    (current-hl (matrix-highlight current-matrix))
-                    (current-enable (matrix-enable current-matrix))
-                    (current-hl-enable
-                     (matrix-highlight-enable current-matrix)))
+              (let ((current-contents (matrix-contents current-matrix)))
                 (do ((y yl (fix:1+ y)))
                     ((fix:= y yu))
-                  (if (not (boolean-vector-ref new-enable y))
+                  (if (not (line-contents-enabled? new-matrix y))
                       (begin
-                        (boolean-vector-set! new-enable y true)
-                        (if (boolean-vector-ref current-enable y)
+                        (enable-line-contents! new-matrix y)
+                        (if (line-contents-enabled? current-matrix y)
                             (begin
                               (string-move! (vector-ref current-contents y)
                                             (vector-ref new-contents y))
@@ -436,86 +476,69 @@
                                           #\space)))
                       (substring-fill! (vector-ref new-contents y)
                                        xl xu #\space))
-                  (cond ((boolean-vector-ref new-hl-enable y)
-                         (boolean-subvector-fill! (vector-ref new-hl y)
-                                                  xl xu highlight))
-                        (highlight
-                         (boolean-vector-set! new-hl-enable y true)
-                         (if (boolean-vector-ref current-hl-enable y)
-                             (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))
-                        ((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
+                  (cond ((line-highlights-enabled? new-matrix y)
+                         (set-subline-highlights! new-matrix y xl xu face))
+                        ((not (default-face? face))
+                         (enable-line-highlights! new-matrix y)
+                         (if (line-highlights-enabled? current-matrix y)
+                             (copy-line-highlights! current-matrix y
+                                                    new-matrix y)
+                             (clear-line-highlights! new-matrix y))
+                         (set-subline-highlights! new-matrix y xl xu face))
+                        ((line-highlights-enabled? current-matrix y)
+                         (copy-line-highlights! current-matrix y new-matrix y)
+                         (clear-subline-highlights! new-matrix y xl xu)
+                         (if (not (line-highlights-cleared? new-matrix y))
+                             (enable-line-highlights! new-matrix y))))))))
+           ((not (default-face? face))
             (do ((y yl (fix:1+ y)))
                 ((fix:= y yu))
               (string-fill! (vector-ref new-contents y) #\space)
-              (boolean-vector-fill! (vector-ref new-hl y) true)
-              (boolean-vector-set! new-enable y true)
-              (boolean-vector-set! new-hl-enable y true)))
+              (enable-line-contents! new-matrix y)
+              (set-line-highlights! new-matrix y face)
+              (enable-line-highlights! new-matrix y)))
            (else
             (do ((y yl (fix:1+ y)))
                 ((fix:= y yu))
               (string-fill! (vector-ref new-contents y) #\space)
-              (boolean-vector-set! new-enable y true)
-              (boolean-vector-set! new-hl-enable y false))))))
+              (enable-line-contents! new-matrix y)
+              (disable-line-highlights! new-matrix y))))))
   (set-screen-needs-update?! screen true))
 \f
-(define (screen-direct-output-char screen x y char highlight)
+(define (screen-direct-output-char screen x y char face)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'direct-output-char
-                                  x y char highlight))
+                                  x y char face))
   (let ((cursor-x (fix:1+ x))
        (current-matrix (screen-current-matrix screen)))
-    (terminal-output-char screen x y char highlight)
+    (terminal-output-char screen x y char face)
     (terminal-move-cursor screen cursor-x y)
     (terminal-flush screen)
     (string-set! (vector-ref (matrix-contents current-matrix) y) x char)
-    (cond ((boolean-vector-ref (matrix-highlight-enable current-matrix) y)
-          (boolean-vector-set! (vector-ref (matrix-highlight current-matrix)
-                                           y)
-                               x highlight))
-         (highlight
-          (boolean-vector-set! (matrix-highlight-enable current-matrix)
-                               y true)
-          (boolean-vector-set! (vector-ref (matrix-highlight current-matrix)
-                                           y)
-                               x highlight)))
+    (cond ((line-highlights-enabled? current-matrix y)
+          (highlight-set! current-matrix y x face))
+         ((not (default-face? face))
+          (enable-line-highlights! current-matrix y)
+          (highlight-set! current-matrix y x face)))
     (set-matrix-cursor-x! current-matrix cursor-x)
     (set-matrix-cursor-x! (screen-new-matrix screen) cursor-x)))
 
-(define (screen-direct-output-substring screen x y string start end highlight)
+(define (screen-direct-output-substring screen x y string start end face)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'direct-output-substring
-                                  x y (string-copy string) start end
-                                  highlight))
+                                  x y (string-copy string) start end face))
   (let ((cursor-x (fix:+ x (fix:- end start)))
        (current-matrix (screen-current-matrix screen)))
-    (terminal-output-substring screen x y string start end highlight)
+    (terminal-output-substring screen x y string start end face)
     (terminal-move-cursor screen cursor-x y)
     (terminal-flush screen)
     (substring-move-left! string start end
                          (vector-ref (matrix-contents current-matrix) y) x)
-    (cond ((boolean-vector-ref (matrix-highlight-enable current-matrix) y)
-          (boolean-subvector-fill!
-           (vector-ref (matrix-highlight current-matrix) y)
-           x cursor-x highlight))
-         (highlight
-          (boolean-vector-set! (matrix-highlight-enable current-matrix)
-                               y true)
-          (boolean-subvector-fill!
-           (vector-ref (matrix-highlight current-matrix) y)
-           x cursor-x highlight)))
+    (cond ((line-highlights-enabled? current-matrix y)
+          (set-subline-highlights! matrix y x cursor-x face))
+         ((not (default-face? face))
+          (enable-line-highlights! current-matrix y)
+          (set-subline-highlights! matrix y x cursor-x face)))
     (set-matrix-cursor-x! current-matrix cursor-x)
     (set-matrix-cursor-x! (screen-new-matrix screen) cursor-x)))
 \f
@@ -527,30 +550,22 @@
        (new-matrix (screen-new-matrix screen)))
     (terminal-clear-screen screen)
     (let ((current-contents (matrix-contents current-matrix))
-         (current-hl (matrix-highlight current-matrix))
-         (current-enable (matrix-enable current-matrix))
-         (current-hl-enable (matrix-highlight-enable current-matrix))
-         (new-contents (matrix-contents new-matrix))
-         (new-hl (matrix-highlight new-matrix))
-         (new-enable (matrix-enable new-matrix))
-         (new-hl-enable (matrix-highlight-enable new-matrix)))
+         (new-contents (matrix-contents new-matrix)))
       (do ((y 0 (fix:1+ y)))
          ((fix:= y y-size))
-       (if (not (boolean-vector-ref new-enable y))
+       (if (not (line-contents-enabled? new-matrix y))
            (begin
              (let ((c (vector-ref new-contents y)))
                (vector-set! new-contents y (vector-ref current-contents y))
                (vector-set! current-contents y c))
-             (boolean-vector-set! new-enable y true)
-             (if (boolean-vector-ref current-hl-enable y)
+             (enable-line-contents! new-matrix y)
+             (if (line-highlights-enabled? current-matrix y)
                  (begin
-                   (let ((h (vector-ref new-hl y)))
-                     (vector-set! new-hl y (vector-ref current-hl y))
-                     (vector-set! current-hl y h))
-                   (boolean-vector-set! new-hl-enable y true)))))
+                   (swap-line-highlights! new-matrix y current-matrix y)
+                   (enable-line-highlights! new-matrix y)))))
        (string-fill! (vector-ref current-contents y) #\space)
-       (boolean-vector-set! current-enable y true)
-       (boolean-vector-set! current-hl-enable y false))))
+       (enable-line-contents! current-matrix y)
+       (disable-line-highlights! current-matrix y))))
   (invalidate-cursor screen)
   (set-screen-needs-update?! screen true))
 
@@ -570,29 +585,25 @@
       ((screen-debug-trace screen) 'screen screen 'scroll-lines-down
                                   xl xu yl yu amount))
   (let ((current-matrix (screen-current-matrix screen)))
-    (and (boolean-subvector-all-elements? (matrix-enable current-matrix)
-                                         yl yu true)
+    (and (multiple-line-contents-enabled? current-matrix yl yu)
         (not (screen-needs-update? screen))
         (let ((scrolled?
                (terminal-scroll-lines-down screen xl xu yl yu amount)))
           (and scrolled?
                (begin
-                 (let ((contents (matrix-contents current-matrix))
-                       (hl (matrix-highlight current-matrix))
-                       (hl-enable (matrix-highlight-enable current-matrix)))
+                 (let ((contents (matrix-contents current-matrix)))
                    (do ((y (fix:-1+ (fix:- yu amount)) (fix:-1+ y))
                         (y* (fix:-1+ yu) (fix:-1+ y*)))
                        ((fix:< y yl))
                      (substring-move-left! (vector-ref contents y) xl xu
                                            (vector-ref contents y*) xl)
-                     (cond ((boolean-vector-ref hl-enable y)
-                            (boolean-vector-set! hl-enable y* true)
-                            (boolean-subvector-move-left!
-                             (vector-ref hl y) xl xu
-                             (vector-ref hl y*) xl))
-                           ((boolean-vector-ref hl-enable y*)
-                            (boolean-subvector-fill! (vector-ref hl y*) xl xu
-                                                     false))))
+                     (cond ((line-highlights-enabled? current-matrix y)
+                            (enable-line-highlights! current-matrix y*)
+                            (copy-subline-highlights! current-matrix y xl xu
+                                                      current-matrix y* xl))
+                           ((line-highlights-enabled? current-matrix y*)
+                            (clear-subline-highlights! current-matrix y*
+                                                       xl xu))))
                    (case scrolled?
                      ((CLEARED)
                       (let ((yu (fix:+ yl amount)))
@@ -602,14 +613,14 @@
                                 ((fix:= y yu))
                               (substring-fill! (vector-ref contents y) xl xu
                                                #\space)
-                              (boolean-vector-set! hl-enable y false))
+                              (disable-line-highlights! current-matrix y))
                             (do ((y yl (fix:1+ y)))
                                 ((fix:= y yu))
                               (substring-fill! (vector-ref contents y) xl xu
                                                #\space)
-                              (if (boolean-vector-ref hl-enable y)
-                                  (boolean-subvector-fill! (vector-ref hl y)
-                                                           xl xu false))))))
+                              (if (line-highlights-enabled? current-matrix y)
+                                  (clear-subline-highlights! current-matrix y
+                                                             xl xu))))))
                      ((CLOBBERED-CURSOR)
                       (invalidate-cursor screen))))
                  scrolled?))))))
@@ -619,29 +630,25 @@
       ((screen-debug-trace screen) 'screen screen 'scroll-lines-up
                                   xl xu yl yu amount))
   (let ((current-matrix (screen-current-matrix screen)))
-    (and (boolean-subvector-all-elements? (matrix-enable current-matrix)
-                                         yl yu true)
+    (and (multiple-line-contents-enabled? current-matrix yl yu)
         (not (screen-needs-update? screen))
         (let ((scrolled?
                (terminal-scroll-lines-up screen xl xu yl yu amount)))
           (and scrolled?
                (begin
-                 (let ((contents (matrix-contents current-matrix))
-                       (hl (matrix-highlight current-matrix))
-                       (hl-enable (matrix-highlight-enable current-matrix)))
+                 (let ((contents (matrix-contents current-matrix)))
                    (do ((y yl (fix:1+ y))
                         (y* (fix:+ yl amount) (fix:1+ y*)))
                        ((fix:= y* yu))
                      (substring-move-left! (vector-ref contents y*) xl xu
                                            (vector-ref contents y) xl)
-                     (cond ((boolean-vector-ref hl-enable y*)
-                            (boolean-vector-set! hl-enable y true)
-                            (boolean-subvector-move-left!
-                             (vector-ref hl y*) xl xu
-                             (vector-ref hl y) xl))
-                           ((boolean-vector-ref hl-enable y)
-                            (boolean-subvector-fill! (vector-ref hl y) xl xu
-                                                     false))))
+                     (cond ((line-highlights-enabled? current-matrix y*)
+                            (enable-line-highlights! current-matrix y)
+                            (copy-subline-highlights! current-matrix y* xl xu
+                                                      current-matrix y xl))
+                           ((line-highlights-enabled? current-matrix y)
+                            (clear-subline-highlights! current-matrix y
+                                                       xl xu))))
                    (case scrolled?
                      ((CLEARED)
                       (if (and (fix:= xl 0)
@@ -650,14 +657,14 @@
                               ((fix:= y yu))
                             (substring-fill! (vector-ref contents y) xl xu
                                              #\space)
-                            (boolean-vector-set! hl-enable y false))
+                            (disable-line-highlights! current-matrix y))
                           (do ((y (fix:- yu amount) (fix:1+ y)))
                               ((fix:= y yu))
                             (substring-fill! (vector-ref contents y) xl xu
                                              #\space)
-                            (if (boolean-vector-ref hl-enable y)
-                                (boolean-subvector-fill! (vector-ref hl y)
-                                                         xl xu false)))))
+                            (if (line-highlights-enabled? current-matrix y)
+                                (clear-subline-highlights! current-matrix y
+                                                           xl xu)))))
                      ((CLOBBERED-CURSOR)
                       (invalidate-cursor screen))))
                  scrolled?))))))
@@ -704,80 +711,75 @@
        (preemption-modulus (screen-preemption-modulus screen))
        (discretionary-flush (screen-operation/discretionary-flush screen))
        (halt-update? (editor-halt-update? current-editor)))
-    (let ((enable (matrix-enable new-matrix)))
-      (let loop ((y 0) (m 0))
-       (cond ((fix:= y y-size)
-              true)
-             ((not (boolean-vector-ref enable y))
-              (loop (fix:+ y 1) m))
-             ((not (fix:= 0 m))
-              (update-line screen y)
-              (loop (fix:+ y 1) (fix:- m 1)))
-             ((begin
-                (if discretionary-flush (discretionary-flush screen))
-                (and (not force?) (halt-update?)))
-              (if (screen-debug-trace screen)
-                  ((screen-debug-trace screen) 'screen screen
-                                               'update-preemption y))
-              false)
-             (else
-              (update-line screen y)
-              (loop (fix:+ y 1) preemption-modulus)))))))
+    (let loop ((y 0) (m 0))
+      (cond ((fix:= y y-size)
+            true)
+           ((not (line-contents-enabled? new-matrix y))
+            (loop (fix:+ y 1) m))
+           ((not (fix:= 0 m))
+            (update-line screen y)
+            (loop (fix:+ y 1) (fix:- m 1)))
+           ((begin
+              (if discretionary-flush (discretionary-flush screen))
+              (and (not force?) (halt-update?)))
+            (if (screen-debug-trace screen)
+                ((screen-debug-trace screen) 'screen screen
+                                             'update-preemption y))
+            false)
+           (else
+            (update-line screen y)
+            (loop (fix:+ y 1) preemption-modulus))))))
 \f
 (define (update-line screen y)
   (let ((current-matrix (screen-current-matrix screen))
        (new-matrix (screen-new-matrix screen))
        (x-size (screen-x-size screen)))
     (let ((current-contents (matrix-contents current-matrix))
-         (current-hl (matrix-highlight current-matrix))
-         (current-enable (matrix-enable current-matrix))
-         (current-hl-enable (matrix-highlight-enable current-matrix))
-         (new-contents (matrix-contents new-matrix))
-         (new-hl (matrix-highlight new-matrix))
-         (new-hl-enable (matrix-highlight-enable new-matrix)))
+         (new-contents (matrix-contents new-matrix)))
       (let ((ccy (vector-ref current-contents y))
-           (chy (vector-ref current-hl y))
            (ncy (vector-ref new-contents y))
-           (nhy (vector-ref new-hl y))
-           (nhey (boolean-vector-ref new-hl-enable y)))
-       (cond ((or (not (boolean-vector-ref current-enable y))
-                  (if (boolean-vector-ref current-hl-enable y)
+           (nhey (line-highlights-enabled? new-matrix y)))
+       (cond ((or (not (line-contents-enabled? current-matrix y))
+                  (if (line-highlights-enabled? current-matrix y)
                       (not nhey)
                       nhey))
               (if nhey
-                  (update-line-ignore-current screen y ncy nhy x-size)
+                  (update-line-ignore-current screen y ncy new-matrix x-size)
                   (update-line-trivial screen y ncy x-size)))
              (nhey
-              (update-line-highlight screen y ccy chy ncy nhy x-size))
+              (update-line-highlight screen y
+                                     ccy current-matrix
+                                     ncy new-matrix
+                                     x-size))
              (else
               (update-line-no-highlight screen y ccy ncy x-size)))
        (vector-set! current-contents y ncy)
-       (boolean-vector-set! current-enable y true)
+       (enable-line-contents! current-matrix y)
        (vector-set! new-contents y ccy)
-       (boolean-vector-set! (matrix-enable new-matrix) y false)
+       (disable-line-contents! new-matrix y)
        (if nhey
            (begin
-             (vector-set! current-hl y nhy)
-             (boolean-vector-set! current-hl-enable y true)
-             (vector-set! new-hl y chy)
-             (boolean-vector-set! new-hl-enable y false))
-           (boolean-vector-set! current-hl-enable y false))))))
-
-(define (update-line-ignore-current screen y nline highlight x-size)
-  (cond ((not (boolean-subvector-uniform? highlight 0 x-size))
+             (swap-line-highlights! current-matrix y new-matrix y)
+             (enable-line-highlights! current-matrix y)
+             (disable-line-highlights! new-matrix y))
+           (disable-line-highlights! current-matrix y))))))
+
+(define (update-line-ignore-current screen y nline matrix x-size)
+  (cond ((not (subline-highlights-uniform? matrix y 0 x-size))
         (let loop ((x 0))
-          (let ((hl (boolean-vector-ref highlight x)))
+          (let ((face (highlight-ref matrix y x)))
             (let ((x*
-                   (boolean-subvector-find-next highlight (fix:1+ x) x-size
-                                                (not hl))))
+                   (find-subline-highlight-change matrix y (fix:1+ x) x-size
+                                                  face)))
               (if x*
                   (begin
-                    (terminal-output-substring screen x y nline x x* hl)
+                    (terminal-output-substring screen x y nline x x* face)
                     (loop x*))
                   (terminal-output-substring screen x y nline x x-size
-                                             hl))))))
-       ((boolean-vector-ref highlight 0)
-        (terminal-output-substring screen 0 y nline 0 x-size true))
+                                             face))))))
+       ((not (default-face? (highlight-ref matrix y 0)))
+        (terminal-output-substring screen 0 y nline 0 x-size
+                                   (highlight-ref matrix y 0)))
        (else
         (update-line-trivial screen y nline x-size))))
 
@@ -852,20 +854,20 @@
          0
          (fix:- end (substring-non-space-start line 0 end))))))
 \f
-(define (update-line-highlight screen y oline ohl nline nhl x-size)
+(define (update-line-highlight screen y oline om nline nm x-size)
   (let find-mismatch ((x 0))
     (if (not (fix:= x x-size))
        (if (and (fix:= (vector-8b-ref oline x) (vector-8b-ref nline x))
-                (eq? (boolean-vector-ref ohl x) (boolean-vector-ref nhl x)))
+                (eqv? (highlight-ref om y x) (highlight-ref nm y x)))
            (find-mismatch (fix:+ x 1))
-           (let ((hl (boolean-vector-ref nhl x)))
+           (let ((face (highlight-ref nm y x)))
              (let find-match ((x* (fix:+ x 1)))
                (cond ((fix:= x* x-size)
-                      (terminal-output-substring screen x y nline x x* hl))
-                     ((not (eq? hl (boolean-vector-ref nhl x*)))
-                      (terminal-output-substring screen x y nline x x* hl)
+                      (terminal-output-substring screen x y nline x x* face))
+                     ((not (eqv? face (highlight-ref nm y x*)))
+                      (terminal-output-substring screen x y nline x x* face)
                       (find-mismatch x*))
-                     ((not (and (eq? hl (boolean-vector-ref ohl x*))
+                     ((not (and (eqv? face (highlight-ref om y x*))
                                 (fix:= (vector-8b-ref oline x*)
                                        (vector-8b-ref nline x*))))
                       (find-match (fix:+ x* 1)))
@@ -873,8 +875,8 @@
                       (let find-end-match ((x** (fix:+ x* 1)))
                         (cond ((fix:= x** x-size)
                                (terminal-output-substring
-                                screen x y nline x x* hl))
-                              ((and (eq? hl (boolean-vector-ref ohl x**))
+                                screen x y nline x x* face))
+                              ((and (eqv? face (highlight-ref om y x**))
                                     (fix:= (vector-8b-ref oline x**)
                                            (vector-8b-ref nline x**)))
                                (find-end-match (fix:+ x** 1)))
@@ -883,7 +885,7 @@
                                (find-match x**))
                               (else
                                (terminal-output-substring
-                                screen x y nline x x* hl)
+                                screen x y nline x x* face)
                                (find-mismatch x**))))))))))))
 \f
 (define-integrable (fix:min x y) (if (fix:< x y) x y))

diff --git a/v7/src/edwin/snr.scm b/v7/src/edwin/snr.scm
index f9fad8d2f29ec3857fd80c82919ed28899fb30c9..0af8c44702c381373f03afa91ec73be45a71161e 100644 (file)
--- a/v7/src/edwin/snr.scm
+++ b/v7/src/edwin/snr.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: snr.scm,v 1.26 1996/12/25 07:20:15 cph Exp $
+;;;    $Id: snr.scm,v 1.27 1997/02/23 06:24:43 cph Exp $
 ;;;
-;;;    Copyright (c) 1995-96 Massachusetts Institute of Technology
+;;;    Copyright (c) 1995-97 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -1425,10 +1425,13 @@ This shows News groups that have been created since the last time that
        (mark-temporary! mark)))))
 
 (define (news-group-buffer:maybe-highlight-header header mark)
-  (highlight-region (make-region (mark+ mark 2) (mark+ mark 6))
-                   (and (ref-variable news-article-highlight-selected mark)
-                        (find-news-article-buffer (mark-buffer mark)
-                                                  header))))
+  (highlight-region
+   (make-region (mark+ mark 2) (mark+ mark 6))
+   (if (and (ref-variable news-article-highlight-selected mark)
+           (find-news-article-buffer (mark-buffer mark)
+                                     header))
+       (highlight-face)
+       (default-face))))
 \f
 (define (news-group-buffer:move-to-header buffer header)
   (let ((point (news-group-buffer:header-mark-1 buffer header))