Replaced the screen struct with SOS classes.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Mon, 17 Jan 2011 08:49:44 +0000 (01:49 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Thu, 2 Jun 2011 17:39:51 +0000 (10:39 -0700)
* src/edwin/buffrm.scm (buffer-frame-needs-redisplay?): Punted; not in
use, and the only user of buffer-window/needs-redisplay?.

* src/edwin/bufwfs.scm (draw-region!, %scroll-lines-up)
(%scroll-lines-down): Should only be used in the tty-screen-specific
output optimizer, and thus may use tty-screen-specific procedures.

* src/edwin/bufwin.scm (buffer-window:update-display!): Check that the
:update-display! message is sent to buffer-windows on tty-screens
only.

(buffer-window/direct-update!): Use the new update-screen-window!
generic procedure, which dispatches according to the screen type.
Moved the original, tty-screen-specific code to a new procedure:
update-tty-screen-window!.

(buffer-window/redraw!): Genericized; moved the tty-screen-specific
code to a new procedure, tty-screen/buffer-window/redraw!.
Non-tty-screen windows just punt.

(buffer-window/set-buffer!): Call update-modified-tick!, else
%window-modified-tick can be #f, causing %notice-window-changes to
complain.  Found when running Edwin interpretively.  The compiled code
had no problem with (fix:> (group-modified-tick group) #f)!

(update-override-string!): Use the tty-screen-specific procedure
tty-screen-get-output-line.  The screen is necessarily a tty-screen
because this procedure is only called by update-buffer-window!, which
is only called by update-tty-screen-window! and
buffer-window:update-display!.

* src/edwin/bufwiu.scm: Genericized the direct-output procedures,
moving their tty-screen-specific code to new procedures named
e.g. tty-screen/buffer-window/direct-output-insert-newline!, which can
safely call e.g. tty-screen-direct-output-move-cursor.  Other types of
screens will, probably, not support direct output.

(buffer-window/needs-redisplay?): Punted; used only by
buffer-frame-needs-redisplay?, which was punted.

* src/edwin/edtfrm.scm (set-editor-frame-size!): Conditionalized a
tiny bit of tty-screen-specific code.

* src/edwin/edwin.pkg: Include SOS.  Renamed several procedures from
screen-... to tty-screen-...  Punted screen-in-update?,
screen-needs-update? and with-screen-in-update?. The "needs-update?"
and "in-update?"  slots are now tty-screen-specific.  Export
tty-screen? for general use.  Export update-screen-window! for use by
buffer-window/direct-update!, and with-tty-screen-in-update for use by
update-tty-screen-window!.  Punted buffer-frame-needs-redisplay?.
Export update-tty-screen-window! so it can be used to implement the
tty-screen method of update-screen-window!.  The method could not be
defined directly in bufwin.scm because define-method means something
different there.

* src/edwin/edwin.sf, src/edwin/make.scm: Load option 'SOS when
syntaxing or loading.

* src/edwin/modwin.scm, src/edwin/utlwin.scm: The :update-display!
message is sent only to windows on tty-screens, so tty-screen-specific
procedures can be used.

* src/edwin/screen.scm: Replaced the screen struct with SOS classes
<screen> and <tty-screen>.  Most of its slots, related to the output
optimizer, went into <tty-screen>, and code using the old
accessor/mutator procedure names was updated.  Some uses moved to
tty-screen-specific methods of new generic procedures like
update-screen!.  Some users, e.g. terminal-output-char, obviously
assume a tty-screen argument.  Others, e.g. screen-move-cursor,
changed their names to show their tty-screen-specificity.  Thus all
users, and users of users, of tty-screen-specific code were updated.

* src/edwin/tterm.scm (scroll-draw-cost): Use tty-screen-specific
procedure tty-screen-line-draw-cost in, which is only used by
console-scroll-lines-up/down!.

12 files changed:
src/edwin/buffrm.scm
src/edwin/bufwfs.scm
src/edwin/bufwin.scm
src/edwin/bufwiu.scm
src/edwin/edtfrm.scm
src/edwin/edwin.pkg
src/edwin/edwin.sf
src/edwin/make.scm
src/edwin/modwin.scm
src/edwin/screen.scm
src/edwin/tterm.scm
src/edwin/utlwin.scm

index 51979c6255160a9ff27a80e205132f9d906be622..37fae76978e5aa0438693e7e9d61513984cdb060 100644 (file)
@@ -159,9 +159,6 @@ USA.
 (define-integrable (buffer-frame-y-size frame)
   (window-y-size (frame-text-inferior frame)))
 
-(define-integrable (buffer-frame-needs-redisplay? frame)
-  (buffer-window/needs-redisplay? (frame-text-inferior frame)))
-
 (define-integrable (window-cursor-enable! frame)
   (buffer-window/cursor-enable! (frame-text-inferior frame)))
 
index c9540999b15830d8b133b706358944100f67ce04..fd71c9b3840eb526582187f7552cfb423336cc22 100644 (file)
@@ -218,7 +218,7 @@ USA.
                         ;; output so as to avoid consing a dummy image
                         ;; buffer.
                         (line
-                         (screen-get-output-line
+                         (tty-screen-get-output-line
                           screen
                           (if (fix:< y yl) yl y)
                           xl* xu
@@ -232,7 +232,7 @@ USA.
                              (cond ((fix:= (vector-ref results 0) end-index)
                                     (let ((xl* (vector-ref results 1)))
                                       (let ((line
-                                             (screen-get-output-line
+                                             (tty-screen-get-output-line
                                               screen
                                               (if (fix:< y yl) yl y)
                                               xl* xu false)))
@@ -335,7 +335,7 @@ USA.
               (let ((yl (fix:max (%window-saved-yl window) new-start-y))
                     (yu (fix:min (%window-saved-yu window) yu)))
                 (and (fix:< amount (fix:- yu yl))
-                     (screen-scroll-lines-up
+                     (tty-screen-scroll-lines-up
                       (%window-saved-screen window)
                       (fix:+ (%window-saved-xl window)
                              (%window-saved-x-start window))
@@ -412,7 +412,7 @@ USA.
                     (yu
                      (fix:min (%window-saved-yu window) (fix:+ yu amount))))
                 (and (fix:< amount (fix:- yu yl))
-                     (screen-scroll-lines-down
+                     (tty-screen-scroll-lines-down
                       (%window-saved-screen window)
                       (fix:+ (%window-saved-xl window)
                              (%window-saved-x-start window))
index 42f4319ffb3ee4fed9bdec26036bf6d86a73b9f6..300b5faef9d4a5fc4a673aff161a823eea335fb4 100644 (file)
@@ -728,6 +728,9 @@ USA.
 (define (buffer-window:update-display! window screen x-start y-start
                                       xl xu yl yu display-style)
   ;; Assumes that interrupts are disabled.
+  (if (not (tty-screen? screen))
+      (error:wrong-type-argument screen "an instance of <tty-screen>"
+                                'BUFFER-WINDOW:UPDATE-DISPLAY!))
   (if (%window-debug-trace window)
       ((%window-debug-trace window) 'window window ':update-display!
                                    screen x-start y-start xl xu yl yu
@@ -749,14 +752,16 @@ USA.
   (if (%window-debug-trace window)
       ((%window-debug-trace window) 'window window 'direct-update!
                                    display-style))
-  (and (%window-saved-screen window)
-       (begin
+  (let ((screen (%window-saved-screen window)))
+    (and screen
+        (update-screen-window! screen window display-style))))
+
+(define (update-tty-screen-window! screen window display-style)
         (%notice-window-changes! window)
-        (with-screen-in-update (%window-saved-screen window) display-style
+        (with-tty-screen-in-update screen display-style
           (lambda ()
             (let ((finished?
-                   (update-buffer-window! window
-                                          (%window-saved-screen window)
+                   (update-buffer-window! window screen
                                           (%window-saved-x-start window)
                                           (%window-saved-y-start window)
                                           (%window-saved-xl window)
@@ -766,7 +771,7 @@ USA.
                                           display-style)))
               (if finished?
                   (set-car! (window-redisplay-flags window) #f))
-              finished?))))))
+              finished?))))
 
 (define (update-buffer-window! window screen x-start y-start xl xu yl yu
                               display-style)
@@ -784,6 +789,10 @@ USA.
 (define (buffer-window/redraw! window)
   (if (%window-debug-trace window)
       ((%window-debug-trace window) 'window window 'force-redraw!))
+  (if (tty-screen? (%window-saved-screen window))
+      (tty-screen/buffer-window/redraw! window)))
+
+(define (tty-screen/buffer-window/redraw! window)
   (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok)))
     (%set-window-force-redraw?! window #t)
     (%recache-window-buffer-local-variables! window)
@@ -891,6 +900,7 @@ USA.
   (if (%window-buffer window)
       (%unset-window-buffer! window))
   (%set-window-buffer! window new-buffer)
+  (update-modified-tick! window)
   (%recache-window-buffer-local-variables! window)
   (let ((group (%window-group window)))
     (add-group-clip-daemon! group (%window-clip-daemon window))
@@ -1177,7 +1187,7 @@ If this is zero, point is always centered after it moves off screen."
            (results substring-image-results))
        (let ((end (string-length string))
              (line
-              (screen-get-output-line screen (fix:+ y-start yl) xl xu #f)))
+              (tty-screen-get-output-line screen (fix:+ y-start yl) xl xu #f)))
          (substring-image! string 0 end
                            line xl (fix:- xu 1)
                            #f 0 results
index 7c078539980a11ca9688712531b80df395fd36db..0017552c14329873245eaaa7f0488cbd9658fb80 100644 (file)
@@ -397,19 +397,17 @@ USA.
 ;;; modified.  None of the procedures may be used if the window needs
 ;;; redisplay.
 
-(define (buffer-window/needs-redisplay? window)
-  (%notice-window-changes! window)
-  (or (window-needs-redisplay? window)
-      (not (%window-saved-screen window))
-      (screen-needs-update? (%window-saved-screen window))))
-
 (define (buffer-window/direct-output-cursor! window)
   (if (%window-debug-trace window)
       ((%window-debug-trace window) 'window window 'direct-output-cursor!))
+  (if (tty-screen? (%window-saved-screen window))
+      (tty-screen/buffer-window/direct-output-cursor! window)))
+
+(define (tty-screen/buffer-window/direct-output-cursor! window)
   (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok)))
     (let ((x-start (inferior-x-start (%window-cursor-inferior window)))
          (y-start (inferior-y-start (%window-cursor-inferior window))))
-      (screen-direct-output-move-cursor
+      (tty-screen-direct-output-move-cursor
        (%window-saved-screen window)
        (fix:+ (%window-saved-x-start window) x-start)
        (fix:+ (%window-saved-y-start window) y-start)))
@@ -420,12 +418,16 @@ USA.
   (if (%window-debug-trace window)
       ((%window-debug-trace window) 'window window
                                    'direct-output-forward-char!))
+  (if (tty-screen? (%window-saved-screen window))
+      (tty-screen/buffer-window/direct-output-forward-char! window)))
+
+(define (tty-screen/buffer-window/direct-output-forward-char! window)
   (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok)))
     (set-window-point-index! window (fix:+ (%window-point-index window) 1))
     (let ((x-start
           (fix:+ (inferior-x-start (%window-cursor-inferior window)) 1))
          (y-start (inferior-y-start (%window-cursor-inferior window))))
-      (screen-direct-output-move-cursor
+      (tty-screen-direct-output-move-cursor
        (%window-saved-screen window)
        (fix:+ (%window-saved-x-start window) x-start)
        (fix:+ (%window-saved-y-start window) y-start))
@@ -437,12 +439,16 @@ USA.
   (if (%window-debug-trace window)
       ((%window-debug-trace window) 'window window
                                    'direct-output-backward-char!))
+  (if (tty-screen? (%window-saved-screen window))
+      (tty-screen/buffer-window/direct-output-backward-char! window)))
+
+(define (tty-screen/buffer-window/direct-output-backward-char! window)
   (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok)))
     (set-window-point-index! window (fix:- (%window-point-index window) 1))
     (let ((x-start
           (fix:- (inferior-x-start (%window-cursor-inferior window)) 1))
          (y-start (inferior-y-start (%window-cursor-inferior window))))
-      (screen-direct-output-move-cursor
+      (tty-screen-direct-output-move-cursor
        (%window-saved-screen window)
        (fix:+ (%window-saved-x-start window) x-start)
        (fix:+ (%window-saved-y-start window) y-start))
@@ -453,15 +459,18 @@ USA.
 (define (buffer-window/home-cursor! window)
   (if (%window-debug-trace window)
       ((%window-debug-trace window) 'window window 'home-cursor!))
-  (if (and (%window-saved-screen window)
-          (fix:<= (%window-saved-xl window) 0)
+  (if (tty-screen? (%window-saved-screen window))
+      (tty-screen/buffer-window/home-cursor! window)))
+
+(define (tty-screen/buffer-window/home-cursor! window)
+  (if (and (fix:<= (%window-saved-xl window) 0)
           (fix:< 0 (%window-saved-xu window))
           (fix:<= (%window-saved-yl window) 0)
           (fix:< 0 (%window-saved-yu window)))
       (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-       (screen-direct-output-move-cursor (%window-saved-screen window)
-                                         (%window-saved-x-start window)
-                                         (%window-saved-y-start window))
+       (tty-screen-direct-output-move-cursor
+        (%window-saved-screen window)
+        (%window-saved-x-start window) (%window-saved-y-start window))
        (set-interrupt-enables! mask)
        unspecific)))
 \f
@@ -469,10 +478,14 @@ USA.
   (if (%window-debug-trace window)
       ((%window-debug-trace window) 'window window
                                    'direct-output-insert-char! char))
+  (if (tty-screen? (%window-saved-screen window))
+      (tty-screen/buffer-window/direct-output-insert-char! window char)))
+
+(define (tty-screen/buffer-window/direct-output-insert-char! window char)
   (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok)))
     (let ((x-start (inferior-x-start (%window-cursor-inferior window)))
          (y-start (inferior-y-start (%window-cursor-inferior window))))
-      (screen-direct-output-char
+      (tty-screen-direct-output-char
        (%window-saved-screen window)
        (fix:+ (%window-saved-x-start window) x-start)
        (fix:+ (%window-saved-y-start window) y-start)
@@ -492,6 +505,12 @@ USA.
       ((%window-debug-trace window) 'window window
                                    'direct-output-insert-substring!
                                    (string-copy string) start end))
+  (if (tty-screen? (%window-saved-screen window))
+      (tty-screen/buffer-window/direct-output-insert-substring!
+       window string start end)))
+
+(define (tty-screen/buffer-window/direct-output-insert-substring!
+        window string start end)
   (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok)))
     (group-insert-substring! (%window-group window)
                             (%window-point-index window)
@@ -499,7 +518,7 @@ USA.
     (let ((x-start (inferior-x-start (%window-cursor-inferior window)))
          (y-start (inferior-y-start (%window-cursor-inferior window)))
          (length (fix:- end start)))
-      (screen-direct-output-substring
+      (tty-screen-direct-output-substring
        (%window-saved-screen window)
        (fix:+ (%window-saved-x-start window) x-start)
        (fix:+ (%window-saved-y-start window) y-start)
@@ -528,15 +547,19 @@ USA.
   (if (%window-debug-trace window)
       ((%window-debug-trace window) 'window window
                                    'direct-output-insert-newline!))
+  (if (tty-screen? (%window-saved-screen window))
+      (tty-screen/buffer-window/direct-output-insert-newline! window)))
+
+(define (tty-screen/buffer-window/direct-output-insert-newline! window)
   (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok)))
     (group-insert-char! (%window-group window)
                        (%window-point-index window)
                        #\newline)
     (let ((end-y (%window-current-end-y window)))
-      (screen-direct-output-move-cursor (%window-saved-screen window)
-                                       (%window-saved-x-start window)
-                                       (fix:+ (%window-saved-y-start window)
-                                              end-y))
+      (tty-screen-direct-output-move-cursor
+       (%window-saved-screen window)
+       (%window-saved-x-start window) (fix:+ (%window-saved-y-start window)
+                                            end-y))
       (%set-window-end-outline!
        window
        (make-outline window 0 1 (%window-end-outline window) #f))
index 020780ff3877b591c8822420793b482b1f9e565d..5ab536f4f59cc2bb9de63661ec4ba65153cb4646 100644 (file)
@@ -87,16 +87,18 @@ USA.
       (set-inferior-start! typein-inferior 0 y*)
       (set-inferior-size! root-inferior x y*))
     (set-inferior-size! typein-inferior x-size typein-y-size)
-    (if (< x (screen-x-size screen))
-       (screen-clear-rectangle screen
-                               x (screen-x-size screen)
-                               0 (screen-y-size screen)
-                               false))
-    (if (< y (screen-y-size screen))
-       (screen-clear-rectangle screen
-                               0 (screen-x-size screen)
-                               y (screen-y-size screen)
-                               false))))
+    (if (tty-screen? screen)
+       (begin
+         (if (< x (screen-x-size screen))
+             (tty-screen-clear-rectangle screen
+                                         x (screen-x-size screen)
+                                         0 (screen-y-size screen)
+                                         false))
+         (if (< y (screen-y-size screen))
+             (tty-screen-clear-rectangle screen
+                                         0 (screen-x-size screen)
+                                         y (screen-y-size screen)
+                                         false))))))
 
 (define-method editor-frame :set-size!
   set-editor-frame-size!)
index aa9648a357ac9ea1baac4b6ddfd264828e3d3db7..52e45491f9340b23b8bac7e8128e6e8ef75b63b6 100644 (file)
@@ -28,6 +28,7 @@ USA.
 \f
 (global-definitions "../runtime/runtime")
 (global-definitions "../xml/xml")
+(global-definitions "../sos/sos")
 
 (define-package (edwin)
   (files "utils"
@@ -268,26 +269,24 @@ USA.
          highlight-face
          initialize-screen-root-window!
          screen-beep
-         screen-clear-rectangle
+         tty-screen-clear-rectangle
          screen-deleted?
-         screen-direct-output-char
-         screen-direct-output-move-cursor
-         screen-direct-output-substring
+         tty-screen-direct-output-char
+         tty-screen-direct-output-move-cursor
+         tty-screen-direct-output-substring
          screen-discard!
          screen-enter!
          screen-exit!
          screen-force-update
-         screen-get-output-line
-         screen-in-update?
-         screen-line-draw-cost
+         tty-screen-get-output-line
+         tty-screen-line-draw-cost
          screen-modeline-event!
-         screen-move-cursor
-         screen-needs-update?
-         screen-output-char
-         screen-output-substring
+         tty-screen-move-cursor
+         tty-screen-output-char
+         tty-screen-output-substring
          screen-root-window
-         screen-scroll-lines-down
-         screen-scroll-lines-up
+         tty-screen-scroll-lines-down
+         tty-screen-scroll-lines-up
          screen-select-cursor!
          screen-select-window!
          screen-selected-window
@@ -300,11 +299,14 @@ USA.
          screen-x-size
          screen-y-size
          screen?
+         tty-screen?
          set-screen-debug-trace!
          set-screen-root-window!
          update-screen!
-         window-screen
-         with-screen-in-update))
+         window-screen)
+  (export (edwin window)
+         update-screen-window!
+         with-tty-screen-in-update))
 
 (define-package (edwin window)
   (files "window"
@@ -354,7 +356,7 @@ USA.
          window-mark->y
          window-mark-visible?
          window-modeline-event!
-         (window-needs-redisplay? buffer-frame-needs-redisplay?)
+         window-needs-redisplay?
          window-override-message
          window-point
          window-point-coordinates
@@ -382,7 +384,8 @@ USA.
          editor-frame-update-display!
          editor-frame-window0
          editor-frame-windows
-         make-editor-frame))
+         make-editor-frame
+         update-tty-screen-window!))
 
 (define-package (edwin window combination)
   (files "comwin")
index 833c211e45791c7bb09f7b5f0c9073c150db3bbc..4237c2ee71e84ee418309339b7e4149355316315 100644 (file)
@@ -25,6 +25,7 @@ USA.
 |#
 
 (load-option 'CREF)
+(load-option 'SOS)
 
 (if (not (name->package '(EDWIN)))
     (let ((package-set (package-set-pathname "edwin")))
index 459456e7e2fce03c9b6f2906abac32f518fec0f3..6591bceb0accd3acec5b1446189daf99b89efafc 100644 (file)
@@ -28,6 +28,7 @@ USA.
 
 (declare (usual-integrations))
 
+(load-option 'SOS)
 (with-loader-base-uri (system-library-uri "edwin/")
   (lambda ()
     (load-package-set "edwin"
index 805c9b7df4462c6dca8786845ceda0be53a94f1a..bd15134ab4c6cf2b9527eae0cc1e2d33c774a751 100644 (file)
@@ -54,7 +54,7 @@ USA.
        (let ((buffer (window-buffer superior)))
          (modeline-string!
           superior
-          (screen-get-output-line
+          (tty-screen-get-output-line
            screen y-start xl xu
            (ref-variable mode-line-inverse-video buffer))
           xl xu)
index 826390a8549f0ada175b5590c65975f26cb5f9c0..fb7bd781bdb33590f5cfaf1a2d4fb075f54f0e8e 100644 (file)
@@ -28,63 +28,76 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define-structure (screen
-                  (constructor make-screen
-                               (state
-                                operation/beep
-                                operation/clear-line!
-                                operation/clear-rectangle!
-                                operation/clear-screen!
-                                operation/discard!
-                                operation/enter!
-                                operation/exit!
-                                operation/flush!
-                                operation/modeline-event!
-                                operation/discretionary-flush
-                                operation/scroll-lines-down!
-                                operation/scroll-lines-up!
-                                operation/wrap-update!
-                                operation/write-char!
-                                operation/write-cursor!
-                                operation/write-substring!
-                                preemption-modulus
-                                x-size
-                                y-size)))
-  (state false read-only true)
-  (operation/beep false read-only true)
-  (operation/clear-line! false read-only true)
-  (operation/clear-rectangle! false read-only true)
-  (operation/clear-screen! false read-only true)
-  (operation/discard! false read-only true)
-  (operation/enter! false read-only true)
-  (operation/exit! false read-only true)
-  (operation/flush! false read-only true)
-  (operation/modeline-event! false read-only true)
-  (operation/discretionary-flush false read-only true)
-  (operation/scroll-lines-down! false read-only true)
-  (operation/scroll-lines-up! false read-only true)
-  (operation/wrap-update! false read-only true)
-  (operation/write-char! false read-only true)
-  (operation/write-cursor! false read-only true)
-  (operation/write-substring! false read-only true)
-  (preemption-modulus false read-only true)
-  (root-window false)
+(define-class (<screen> (constructor %make-screen ()))
+    ()
+  ;; An rtd:editor-frame
+  (root-window         define standard initial-value #f)
+
   ;; Visibility is one of the following:
   ;; VISIBLE PARTIALLY-OBSCURED OBSCURED UNMAPPED DELETED
-  (visibility 'VISIBLE)
-  (needs-update? false)
-  (in-update? false)
-  (x-size false)
-  (y-size false)
+  (visibility          define standard initial-value 'VISIBLE)
+
+  ;; Width and height in characters cells -- columns and lines.
+  (x-size              define standard initial-value #f)
+  (y-size              define standard initial-value #f)
+
+  ;; Set this variable in the debugger to trace interesting events.
+  (debug-trace         define standard initial-value #f))
+
+(define-class (<tty-screen> (constructor make-screen
+                                        (state
+                                         operation/beep
+                                         operation/clear-line!
+                                         operation/clear-rectangle!
+                                         operation/clear-screen!
+                                         operation/discard!
+                                         operation/enter!
+                                         operation/exit!
+                                         operation/flush!
+                                         operation/modeline-event!
+                                         operation/discretionary-flush
+                                         operation/scroll-lines-down!
+                                         operation/scroll-lines-up!
+                                         operation/wrap-update!
+                                         operation/write-char!
+                                         operation/write-cursor!
+                                         operation/write-substring!
+                                         preemption-modulus
+                                         x-size
+                                         y-size)))
+    (<screen>)
+
+  (state               define standard accessor screen-state)
+  (operation/beep      define accessor)
+  (operation/clear-line! define accessor)
+  (operation/clear-rectangle! define accessor)
+  (operation/clear-screen! define accessor)
+  (operation/discard!  define accessor)
+  (operation/enter!    define accessor)
+  (operation/exit!     define accessor)
+  (operation/flush!    define accessor)
+  (operation/modeline-event! define accessor)
+  (operation/discretionary-flush define accessor)
+  (operation/scroll-lines-down! define accessor)
+  (operation/scroll-lines-up! define accessor)
+  (operation/wrap-update! define accessor)
+  (operation/write-char! define accessor)
+  (operation/write-cursor! define accessor)
+  (operation/write-substring! define accessor)
+  (preemption-modulus  define accessor initial-value #f)
+  (needs-update?       define standard initial-value #f)
+  (in-update?          define standard initial-value #f)
 
   ;; Description of actual screen contents.
-  current-matrix
+  (current-matrix      define standard)
 
   ;; Description of desired screen contents.
-  new-matrix
+  (new-matrix          define standard))
 
-  ;; Set this variable in the debugger to trace interesting events.
-  (debug-trace false))
+(define-method initialize-instance ((screen <tty-screen>))
+  (call-next-method screen)
+  (set-tty-screen-current-matrix! screen (make-matrix screen))
+  (set-tty-screen-new-matrix! screen (make-matrix screen)))
 
 (define (guarantee-screen object procedure)
   (if (not (screen? object))
@@ -96,35 +109,44 @@ USA.
    (make-editor-frame
     screen
     buffer
-    (bufferset-find-or-create-buffer bufferset (make-typein-buffer-name -1))))
-  (set-screen-current-matrix! screen (make-matrix screen))
-  (set-screen-new-matrix! screen (make-matrix screen)))
+    (bufferset-find-or-create-buffer bufferset (make-typein-buffer-name -1)))))
 \f
-(define (screen-beep screen)
-  ((screen-operation/beep screen) screen))
+(define-generic screen-beep (screen))
+
+(define-method screen-beep ((screen <tty-screen>))
+  (let ((op (tty-screen-operation/beep screen))) (op screen)))
 
-(define (screen-enter! screen)
-  ((screen-operation/enter! screen) screen)
+(define-generic screen-enter! (screen))
+
+(define-method screen-enter! ((screen <tty-screen>))
+  (let ((op (tty-screen-operation/enter! screen))) (op screen))
   (screen-modeline-event! screen
                          (screen-selected-window screen)
                          'SELECT-SCREEN))
 
-(define (screen-exit! screen)
-  ((screen-operation/exit! screen) screen)
+(define-generic screen-exit! (screen))
+
+(define-method screen-exit! ((screen <tty-screen>))
+  (let ((op (tty-screen-operation/exit! screen))) (op screen))
   (screen-modeline-event! screen
                          (screen-selected-window screen)
                          'DESELECT-SCREEN))
 
-(define (screen-discard! screen)
+(define-generic screen-discard! (screen))
+
+(define-method screen-discard! ((screen <tty-screen>))
   (if (not (screen-deleted? screen))
       (begin
        (set-screen-visibility! screen 'DELETED)
        (for-each (lambda (window) (send window ':kill!))
                  (screen-window-list screen))
-       ((screen-operation/discard! screen) screen))))
+       ((tty-screen-operation/discard! screen) screen))))
+
+(define-generic screen-modeline-event! (screen window type))
 
-(define (screen-modeline-event! screen window type)
-  ((screen-operation/modeline-event! screen) screen window type))
+(define-method screen-modeline-event! ((screen <tty-screen>) window type)
+  (let ((op (tty-screen-operation/modeline-event! screen)))
+    (op screen window type)))
 
 (define-integrable (screen-selected-window screen)
   (editor-frame-selected-window (screen-root-window screen)))
@@ -158,16 +180,18 @@ USA.
 (define-integrable (screen-deleted? screen)
   (eq? 'DELETED (screen-visibility screen)))
 
-(define (update-screen! screen display-style)
+(define-generic update-screen! (screen display-style))
+
+(define-method update-screen! ((screen <tty-screen>) display-style)
   (if (display-style/discard-screen-contents? display-style)
       (screen-force-update screen))
   (let ((finished?
-        (with-screen-in-update screen display-style
+        (with-tty-screen-in-update screen display-style
           (lambda ()
             (editor-frame-update-display! (screen-root-window screen)
                                           display-style)))))
     (if (eq? finished? #t)
-       (set-screen-needs-update?! screen #f))
+       (set-tty-screen-needs-update?! screen #f))
     finished?))
 \f
 ;;; Interface from update optimizer to terminal:
@@ -176,47 +200,47 @@ USA.
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'terminal screen 'scroll-lines-down
                                   xl xu yl yu amount))
-  ((screen-operation/scroll-lines-down! screen) screen xl xu yl yu amount))
+  ((tty-screen-operation/scroll-lines-down! screen) screen xl xu yl yu amount))
 
 (define-integrable (terminal-scroll-lines-up screen xl xu yl yu amount)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'terminal screen 'scroll-lines-up
                                   xl xu yl yu amount))
-  ((screen-operation/scroll-lines-up! screen) screen xl xu yl yu amount))
+  ((tty-screen-operation/scroll-lines-up! screen) screen xl xu yl yu amount))
 
 (define-integrable (terminal-flush screen)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'terminal screen 'flush))
-  ((screen-operation/flush! screen) screen))
+  ((tty-screen-operation/flush! screen) screen))
 
 (define-integrable (terminal-move-cursor screen x y)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'terminal screen 'move-cursor x y))
-  ((screen-operation/write-cursor! screen) screen x y))
+  ((tty-screen-operation/write-cursor! screen) screen x y))
 
 (define-integrable (terminal-clear-screen screen)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'terminal screen 'clear-screen))
-  ((screen-operation/clear-screen! screen) screen))
+  ((tty-screen-operation/clear-screen! screen) screen))
 
 (define-integrable (terminal-clear-line screen x y first-unused-x)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'terminal screen 'clear-line
                                   x y first-unused-x))
-  ((screen-operation/clear-line! screen) screen x y first-unused-x))
+  ((tty-screen-operation/clear-line! screen) screen x y first-unused-x))
 
 (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 face))
-  ((screen-operation/write-char! screen) screen x y char face))
+  ((tty-screen-operation/write-char! screen) screen x y char face))
 
 (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 face))
-  ((screen-operation/write-substring! screen) screen x y string start end
-                                             face))
+  ((tty-screen-operation/write-substring! screen)
+   screen x y string start end face))
 \f
 ;;;; Update Optimization
 
@@ -334,49 +358,51 @@ USA.
 (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)
+(define-generic set-screen-size! (screen x-size y-size))
+
+(define-method set-screen-size! ((screen <tty-screen>) x-size y-size)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'set-size! x-size y-size))
   (without-interrupts
    (lambda ()
      (set-screen-x-size! screen x-size)
      (set-screen-y-size! screen y-size)
-     (set-screen-current-matrix! screen (make-matrix screen))
-     (set-screen-new-matrix! screen (make-matrix screen))
+     (set-tty-screen-current-matrix! screen (make-matrix screen))
+     (set-tty-screen-new-matrix! screen (make-matrix screen))
      (send (screen-root-window screen) ':set-size! x-size y-size))))
 
-(define (screen-move-cursor screen x y)
+(define (tty-screen-move-cursor screen x y)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'move-cursor x y))
-  (let ((new-matrix (screen-new-matrix screen)))
+  (let ((new-matrix (tty-screen-new-matrix screen)))
     (set-matrix-cursor-x! new-matrix x)
     (set-matrix-cursor-y! new-matrix y))
   ;; Kludge: forget current position of cursor in order to force it to
   ;; move.  Works around side-effects in terminal that move cursor.
-  (let ((current-matrix (screen-current-matrix screen)))
+  (let ((current-matrix (tty-screen-current-matrix screen)))
     (set-matrix-cursor-x! current-matrix #f)
     (set-matrix-cursor-y! current-matrix #f)))
 
-(define (screen-direct-output-move-cursor screen x y)
+(define (tty-screen-direct-output-move-cursor screen x y)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'direct-output-move-cursor
                                   x y))
   (terminal-move-cursor screen x y)
   (terminal-flush screen)
-  (let ((current-matrix (screen-current-matrix screen))
-       (new-matrix (screen-new-matrix screen)))
+  (let ((current-matrix (tty-screen-current-matrix screen))
+       (new-matrix (tty-screen-new-matrix screen)))
     (set-matrix-cursor-x! current-matrix x)
     (set-matrix-cursor-y! current-matrix y)
     (set-matrix-cursor-x! new-matrix x)
     (set-matrix-cursor-y! new-matrix y)))
 \f
-(define (screen-output-char screen x y char face)
+(define (tty-screen-output-char screen x y char face)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'output-char x y char face))
-  (let ((new-matrix (screen-new-matrix screen)))
+  (let ((new-matrix (tty-screen-new-matrix screen)))
     (cond ((not (line-contents-enabled? new-matrix y))
           (enable-line-contents! new-matrix y)
-          (set-screen-needs-update?! screen true)
+          (set-tty-screen-needs-update?! screen true)
           (initialize-new-line-contents screen y)
           (if (not (default-face? face))
               (begin
@@ -391,14 +417,14 @@ USA.
           (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 face)
+(define (tty-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 face))
-  (let ((new-matrix (screen-new-matrix screen)))
+  (let ((new-matrix (tty-screen-new-matrix screen)))
     (let ((full-line? (and (fix:= xl 0) (fix:= xu (screen-x-size screen)))))
       (cond ((not (line-contents-enabled? new-matrix y))
             (enable-line-contents! new-matrix y)
-            (set-screen-needs-update?! screen true)
+            (set-tty-screen-needs-update?! screen true)
             (if (not full-line?) (initialize-new-line-contents screen y))
             (if (not (default-face? face))
                 (begin
@@ -417,36 +443,36 @@ USA.
             (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 face)
+(define (tty-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))
-                                               face)
+                       (tty-screen-get-output-line screen y x
+                                                   (fix:+ x (fix:- end start))
+                                                   face)
                        x))
 
 (define-integrable (initialize-new-line-contents screen y)
-  (if (line-contents-enabled? (screen-current-matrix screen) y)
+  (if (line-contents-enabled? (tty-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))
+       (vector-ref (matrix-contents (tty-screen-current-matrix screen)) y)
+       (vector-ref (matrix-contents (tty-screen-new-matrix screen)) y))
       (string-fill!
-       (vector-ref (matrix-contents (screen-new-matrix screen)) y)
+       (vector-ref (matrix-contents (tty-screen-new-matrix screen)) y)
        #\space)))
 
 (define-integrable (initialize-new-line-highlight screen y)
-  (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)))
+  (if (line-highlights-enabled? (tty-screen-current-matrix screen) y)
+      (copy-line-highlights! (tty-screen-current-matrix screen) y
+                            (tty-screen-new-matrix screen) y)
+      (clear-line-highlights! (tty-screen-new-matrix screen) y)))
 \f
-(define (screen-clear-rectangle screen xl xu yl yu face)
+(define (tty-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 face))
-  (let ((new-matrix (screen-new-matrix screen)))
+  (let ((new-matrix (tty-screen-new-matrix screen)))
     (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-matrix (tty-screen-current-matrix screen)))
               (let ((current-contents (matrix-contents current-matrix)))
                 (do ((y yl (fix:1+ y)))
                     ((fix:= y yu))
@@ -490,14 +516,14 @@ USA.
               (string-fill! (vector-ref new-contents y) #\space)
               (enable-line-contents! new-matrix y)
               (disable-line-highlights! new-matrix y))))))
-  (set-screen-needs-update?! screen true))
+  (set-tty-screen-needs-update?! screen true))
 \f
-(define (screen-direct-output-char screen x y char face)
+(define (tty-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 face))
   (let ((cursor-x (fix:1+ x))
-       (current-matrix (screen-current-matrix screen)))
+       (current-matrix (tty-screen-current-matrix screen)))
     (terminal-output-char screen x y char face)
     (terminal-move-cursor screen cursor-x y)
     (terminal-flush screen)
@@ -508,14 +534,14 @@ USA.
           (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)))
+    (set-matrix-cursor-x! (tty-screen-new-matrix screen) cursor-x)))
 
-(define (screen-direct-output-substring screen x y string start end face)
+(define (tty-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 face))
   (let ((cursor-x (fix:+ x (fix:- end start)))
-       (current-matrix (screen-current-matrix screen)))
+       (current-matrix (tty-screen-current-matrix screen)))
     (terminal-output-substring screen x y string start end face)
     (terminal-move-cursor screen cursor-x y)
     (terminal-flush screen)
@@ -527,14 +553,16 @@ USA.
           (enable-line-highlights! current-matrix y)
           (set-subline-highlights! current-matrix y x cursor-x face)))
     (set-matrix-cursor-x! current-matrix cursor-x)
-    (set-matrix-cursor-x! (screen-new-matrix screen) cursor-x)))
+    (set-matrix-cursor-x! (tty-screen-new-matrix screen) cursor-x)))
 \f
-(define (screen-force-update screen)
+(define-generic screen-force-update (screen))
+
+(define-method screen-force-update ((screen <tty-screen>))
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'force-update))
   (let ((y-size (screen-y-size screen))
-       (current-matrix (screen-current-matrix screen))
-       (new-matrix (screen-new-matrix screen)))
+       (current-matrix (tty-screen-current-matrix screen))
+       (new-matrix (tty-screen-new-matrix screen)))
     (terminal-clear-screen screen)
     (let ((current-contents (matrix-contents current-matrix))
          (new-contents (matrix-contents new-matrix)))
@@ -554,11 +582,11 @@ USA.
        (enable-line-contents! current-matrix y)
        (disable-line-highlights! current-matrix y))))
   (invalidate-cursor screen)
-  (set-screen-needs-update?! screen true))
+  (set-tty-screen-needs-update?! screen true))
 
 (define (invalidate-cursor screen)
-  (let ((current-matrix (screen-current-matrix screen))
-       (new-matrix (screen-new-matrix screen)))
+  (let ((current-matrix (tty-screen-current-matrix screen))
+       (new-matrix (tty-screen-new-matrix screen)))
     (if (or (matrix-cursor-x current-matrix)
            (matrix-cursor-y current-matrix))
        (begin
@@ -567,13 +595,13 @@ USA.
          (set-matrix-cursor-x! current-matrix #f)
          (set-matrix-cursor-y! current-matrix #f)))))
 \f
-(define (screen-scroll-lines-down screen xl xu yl yu amount)
+(define (tty-screen-scroll-lines-down screen xl xu yl yu amount)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'scroll-lines-down
                                   xl xu yl yu amount))
-  (let ((current-matrix (screen-current-matrix screen)))
+  (let ((current-matrix (tty-screen-current-matrix screen)))
     (and (multiple-line-contents-enabled? current-matrix yl yu)
-        (not (screen-needs-update? screen))
+        (not (tty-screen-needs-update? screen))
         (let ((scrolled?
                (terminal-scroll-lines-down screen xl xu yl yu amount)))
           (and scrolled?
@@ -612,13 +640,13 @@ USA.
                       (invalidate-cursor screen))))
                  scrolled?))))))
 \f
-(define (screen-scroll-lines-up screen xl xu yl yu amount)
+(define (tty-screen-scroll-lines-up screen xl xu yl yu amount)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'scroll-lines-up
                                   xl xu yl yu amount))
-  (let ((current-matrix (screen-current-matrix screen)))
+  (let ((current-matrix (tty-screen-current-matrix screen)))
     (and (multiple-line-contents-enabled? current-matrix yl yu)
-        (not (screen-needs-update? screen))
+        (not (tty-screen-needs-update? screen))
         (let ((scrolled?
                (terminal-scroll-lines-up screen xl xu yl yu amount)))
           (and scrolled?
@@ -656,48 +684,60 @@ USA.
                       (invalidate-cursor screen))))
                  scrolled?))))))
 \f
-(define (with-screen-in-update screen display-style thunk)
+(define-generic update-screen-window! (screen window display-style)
+  ;; Mostly for dispatching on the saved-screen of WINDOW in
+  ;; buffer-window/direct-update!.  It is assumed that SCREEN is,
+  ;; indeed, the saved-screen of WINDOW, a buffer-window.
+  )
+
+(define-method update-screen-window!
+    ((screen <tty-screen>) window display-style)
+  (update-tty-screen-window! screen window display-style))
+
+(define (with-tty-screen-in-update screen display-style thunk)
   (without-interrupts
    (lambda ()
-     (let ((old-flag (screen-in-update? screen)))
-       (set-screen-in-update?! screen true)
+     (let ((old-flag (tty-screen-in-update? screen)))
+       (set-tty-screen-in-update?! screen true)
        (let ((finished?
-             ((screen-operation/wrap-update! screen)
+             ((tty-screen-operation/wrap-update! screen)
               screen
               (lambda ()
                 (and (thunk)
                      (if (memq (screen-visibility screen)
                                '(VISIBLE PARTIALLY-OBSCURED))
-                         (and (or (not (screen-needs-update? screen))
+                         (and (or (not (tty-screen-needs-update? screen))
                                   (and (not (display-style/no-screen-output?
                                              display-style))
-                                       (screen-update screen display-style)))
+                                       (tty-screen-update
+                                        screen display-style)))
                               (begin
-                                (screen-update-cursor screen)
+                                (tty-screen-update-cursor screen)
                                 #t))
                          'INVISIBLE))))))
-        (set-screen-in-update?! screen old-flag)
+        (set-tty-screen-in-update?! screen old-flag)
         finished?)))))
 
-(define (screen-update-cursor screen)
-  (let ((x (matrix-cursor-x (screen-new-matrix screen)))
-       (y (matrix-cursor-y (screen-new-matrix screen))))
-    (if (not (and (eqv? x (matrix-cursor-x (screen-current-matrix screen)))
-                 (eqv? y (matrix-cursor-y (screen-current-matrix screen)))))
+(define (tty-screen-update-cursor screen)
+  (let ((x (matrix-cursor-x (tty-screen-new-matrix screen)))
+       (y (matrix-cursor-y (tty-screen-new-matrix screen))))
+    (if (not (and (eqv? x (matrix-cursor-x (tty-screen-current-matrix screen)))
+                 (eqv? y (matrix-cursor-y
+                          (tty-screen-current-matrix screen)))))
        (terminal-move-cursor screen x y))
-    (set-matrix-cursor-x! (screen-current-matrix screen) x)
-    (set-matrix-cursor-y! (screen-current-matrix screen) y)))
+    (set-matrix-cursor-x! (tty-screen-current-matrix screen) x)
+    (set-matrix-cursor-y! (tty-screen-current-matrix screen) y)))
 
-(define (screen-update screen force?)
+(define (tty-screen-update screen force?)
   ;; Update the actual terminal screen based on the data in `new-matrix'.
   ;; Value is #F if redisplay stopped due to pending input.
   ;; FORCE? true means do not stop for pending input.
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'screen screen 'update force?))
-  (let ((new-matrix (screen-new-matrix screen))
+  (let ((new-matrix (tty-screen-new-matrix screen))
        (y-size (screen-y-size screen))
-       (preemption-modulus (screen-preemption-modulus screen))
-       (discretionary-flush (screen-operation/discretionary-flush screen))
+       (preemption-modulus (tty-screen-preemption-modulus screen))
+       (discretionary-flush (tty-screen-operation/discretionary-flush screen))
        (halt-update? (editor-halt-update? current-editor)))
     (let loop ((y 0) (m 0))
       (cond ((fix:= y y-size)
@@ -719,8 +759,8 @@ USA.
             (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))
+  (let ((current-matrix (tty-screen-current-matrix screen))
+       (new-matrix (tty-screen-new-matrix screen))
        (x-size (screen-x-size screen)))
     (let ((current-contents (matrix-contents current-matrix))
          (new-contents (matrix-contents new-matrix)))
@@ -835,8 +875,9 @@ USA.
           (if (fix:< nlen olen)
               (terminal-clear-line screen nlen y olen))))))
 
-(define (screen-line-draw-cost screen y)
-  (let ((line (vector-ref (matrix-contents (screen-current-matrix screen)) y)))
+(define (tty-screen-line-draw-cost screen y)
+  (let ((line (vector-ref (matrix-contents (tty-screen-current-matrix screen))
+                         y)))
     (let ((end (substring-non-space-end line 0 (string-length line))))
       (if (fix:= 0 end)
          0
index eb9151bde35b1642103c9befe58c791948f07757..3a78206563d211a106f86bf4108189f689c5534d 100644 (file)
@@ -649,7 +649,7 @@ USA.
 
 (define (scroll-draw-cost screen yl yu)
   (do ((yl yl (fix:+ yl 1))
-       (cost 0 (fix:+ cost (screen-line-draw-cost screen yl))))
+       (cost 0 (fix:+ cost (tty-screen-line-draw-cost screen yl))))
       ((fix:= yl yu) cost)))
 \f
 ;;;; Termcap Commands
@@ -1203,4 +1203,4 @@ Note that the multiply factors are in tenths of characters.  |#
        (set-terminal-state/delete-line-cost! state delete-line-cost)
        (set-terminal-state/delete-line-next-cost! state delete-line-next-cost)
        (set-terminal-state/scroll-region-cost! state scroll-region-cost)
-       (set-screen-size! screen x-size y-size)))))
\ No newline at end of file
+       (set-screen-size! screen x-size y-size)))))
index 3608592830349f369e4d4354d2eed2313c0727b8..713a22fdb0e11fa9de322d70b34c8b911bc4c51e 100644 (file)
@@ -36,10 +36,11 @@ USA.
 (define (blank-window:update-display! window screen x-start y-start
                                      xl xu yl yu display-style)
   window display-style                 ;ignore
-  (screen-clear-rectangle screen
-                         (fix:+ x-start xl) (fix:+ x-start xu)
-                         (fix:+ y-start yl) (fix:+ y-start yu)
-                         false)
+  (tty-screen-clear-rectangle
+   screen
+   (fix:+ x-start xl) (fix:+ x-start xu)
+   (fix:+ y-start yl) (fix:+ y-start yu)
+   false)
   true)
 
 (define-method blank-window :update-display!
@@ -76,7 +77,7 @@ USA.
            (let loop ((y (fix:+ y-start yl)))
              (if (fix:< y yu)
                  (begin
-                   (screen-output-char screen xl y #\| false)
+                   (tty-screen-output-char screen xl y #\| false)
                    (loop (fix:+ y 1)))))))))
   true)
 
@@ -112,7 +113,7 @@ USA.
   (if (and (with-instance-variables cursor-window window () enabled?)
           (fix:< xl xu)
           (fix:< yl yu))
-      (screen-move-cursor screen x-start y-start))
+      (tty-screen-move-cursor screen x-start y-start))
   true)
 
 (define-method cursor-window :update-display!