Ugly fix for incorrect scrolling on VT220

This commit is contained in:
John Lorentzson 2025-07-30 11:09:15 +02:00
parent df009bac42
commit 04be194c46

View file

@ -146,32 +146,50 @@ serial connection the editor normally runs under.")
(write-char #\K *eio*)
(force-output *eio*))
(defvar *top-scroll-region* 1)
(defvar *bottom-scroll-region* 24)
(defun set-scrolling-region (&optional top bottom)
(assert (or (and (typep top 'integer) (typep bottom 'integer))
(and (null top) (null bottom))))
(cond ((and top bottom)
;; Set the region
(write-byte #x1B *eio*)
(format *eio* "[~D;~Dr" top bottom))
(format *eio* "[~D;~Dr" top bottom)
(setf *top-scroll-region* top
*bottom-scroll-region* bottom))
(t
;; Reset the region to fullscreen
(write-byte #x1B *eio*)
(format *eio* "[1;24r"))))
(format *eio* "[1;24r")
(setf *top-scroll-region* 1
*bottom-scroll-region* 24))))
;; OOPS! The scrolling commands just don't exist on the VT220!
;; TODO: Replace them!
(defun scroll-screen-down (&optional (amount 1))
(defun scroll-screen-down ()
(save-cursor)
(move-cursor *top-scroll-region* 0)
(write-byte #x1B *eio*)
(write-char #\[ *eio*)
(format *eio* "~D" amount)
(write-char #\T *eio*))
(write-char #\M *eio*)
(force-output *eio*)
(restore-cursor))
(defun scroll-screen-up (&optional (amount 1))
(defun save-cursor ()
(write-byte #x1B *eio*)
(write-char #\[ *eio*)
(format *eio* "~D" amount)
(write-char #\S *eio*))
(write-char #\7 *eio*))
(defun restore-cursor ()
(write-byte #x1B *eio*)
(write-char #\8 *eio*))
(defun scroll-screen-up ()
(save-cursor)
(move-cursor *bottom-scroll-region* 0)
(write-byte #x1B *eio*)
(write-char #\D *eio*)
(restore-cursor))
(defun hide-cursor ()
(write-byte #x1B *eio*)
@ -548,7 +566,7 @@ Additionally ensures correct line numbers on the way, as a bonus."
(defmethod scroll-view-down ((view buffer-view))
(set-scrolling-region 1 (height view))
(scroll-screen-up 1) ; view goes down, screen contents go up
(scroll-screen-up) ; view goes down, screen contents go up
(set-scrolling-region)
(update-view-bottom view)
(setf (top-line view) (next-line (top-line view))
@ -559,7 +577,7 @@ Additionally ensures correct line numbers on the way, as a bonus."
(defmethod scroll-view-up ((view buffer-view))
(set-scrolling-region 1 (height view))
(scroll-screen-down 1) ; view goes up, screen contents go down
(scroll-screen-down) ; view goes up, screen contents go down
(set-scrolling-region)
(update-view-bottom view)
(setf (top-line view)