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*) (write-char #\K *eio*)
(force-output *eio*)) (force-output *eio*))
(defvar *top-scroll-region* 1)
(defvar *bottom-scroll-region* 24)
(defun set-scrolling-region (&optional top bottom) (defun set-scrolling-region (&optional top bottom)
(assert (or (and (typep top 'integer) (typep bottom 'integer)) (assert (or (and (typep top 'integer) (typep bottom 'integer))
(and (null top) (null bottom)))) (and (null top) (null bottom))))
(cond ((and top bottom) (cond ((and top bottom)
;; Set the region ;; Set the region
(write-byte #x1B *eio*) (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 (t
;; Reset the region to fullscreen ;; Reset the region to fullscreen
(write-byte #x1B *eio*) (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! ;; OOPS! The scrolling commands just don't exist on the VT220!
;; TODO: Replace them! ;; 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-byte #x1B *eio*)
(write-char #\[ *eio*) (write-char #\M *eio*)
(format *eio* "~D" amount) (force-output *eio*)
(write-char #\T *eio*)) (restore-cursor))
(defun scroll-screen-up (&optional (amount 1)) (defun save-cursor ()
(write-byte #x1B *eio*) (write-byte #x1B *eio*)
(write-char #\[ *eio*) (write-char #\7 *eio*))
(format *eio* "~D" amount)
(write-char #\S *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 () (defun hide-cursor ()
(write-byte #x1B *eio*) (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)) (defmethod scroll-view-down ((view buffer-view))
(set-scrolling-region 1 (height 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) (set-scrolling-region)
(update-view-bottom view) (update-view-bottom view)
(setf (top-line view) (next-line (top-line 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)) (defmethod scroll-view-up ((view buffer-view))
(set-scrolling-region 1 (height 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) (set-scrolling-region)
(update-view-bottom view) (update-view-bottom view)
(setf (top-line view) (setf (top-line view)