;;; 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)))
(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))
(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))
(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
(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)
((%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)
(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)
(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))
(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))
(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)))
(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:
(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
(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
(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
(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))
(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)
(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)
(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)))
(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
(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?
(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?
(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)
(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)))
(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