Ugly fix for incorrect scrolling on VT220
This commit is contained in:
parent
df009bac42
commit
04be194c46
1 changed files with 30 additions and 12 deletions
|
@ -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)
|
||||||
|
|
Loading…
Add table
Reference in a new issue