Add page up and page down commands to the editor

This commit is contained in:
John Lorentzson 2025-07-31 13:23:52 +02:00
parent 1f52377b2b
commit 0451b5b7d1

View file

@ -805,6 +805,42 @@ Additionally ensures correct line numbers on the way, as a bonus."
(char= (char (line-content line) (1- column)) #\Space))) (char= (char (line-content line) (1- column)) #\Space)))
(update-buffer-cursor buffer))) (update-buffer-cursor buffer)))
(defun com-next-page ()
(with-editor-accessors *editor* (:current-line line
:current-buffer buffer)
(let ((view (buffer-view buffer)))
(cond ((or (null (bottom-line view))
(eql line (bottom-line view)))
(feep))
((< (view-line-number view (bottom-line view))
(height view))
(setf line (bottom-line view))
(update-buffer-cursor buffer))
(t
(setf line (bottom-line view))
(setf (top-line view) (bottom-line view))
(update-buffer-cursor buffer)
(redisplay-view (current-view *editor*)))))))
(defun com-previous-page ()
(with-editor-accessors *editor* (:current-line cursor-line
:current-buffer buffer)
(let ((view (buffer-view buffer)))
(cond ((eql cursor-line (first-line buffer))
(feep))
((line-in-view (first-line buffer) view)
(setf cursor-line (first-line buffer))
(update-buffer-cursor buffer))
(t
(loop :repeat (height view)
:for current-line := cursor-line
:then (prev-line current-line)
:until (null current-line)
:do (setf cursor-line current-line
(top-line view) current-line))
(update-buffer-cursor buffer)
(redisplay-view view))))))
(defun com-new-buffer () (defun com-new-buffer ()
(setf (current-buffer *editor*) (setf (current-buffer *editor*)
(make-instance 'buffer)) (make-instance 'buffer))
@ -979,7 +1015,9 @@ Additionally ensures correct line numbers on the way, as a bonus."
((:m . #\f) com-forward-word) ((:m . #\f) com-forward-word)
((:c . #\w) com-forward-word) ((:c . #\w) com-forward-word)
((:m . #\b) com-backward-word) ((:m . #\b) com-backward-word)
((:c . #\q) com-backward-word))) ((:c . #\q) com-backward-word)
(:page-down com-next-page)
(:page-up com-previous-page)))
(defun key-command-dispatch (key) (defun key-command-dispatch (key)
(when (numberp key) (when (numberp key)