Fix Qt viewport paging semantics
ober
95be80af62d031a64c9c3024772efac16bec1fa9
--- a/src/jerboa-emacs/core.ss +++ b/src/jerboa-emacs/core.ss @@ -495,7 +495,7 @@ (keymap-bind! *global-keymap* "C-p" 'previous-line) (keymap-bind! *global-keymap* "C-a" 'beginning-of-line) (keymap-bind! *global-keymap* "C-e" 'end-of-line) - (keymap-bind! *global-keymap* "C-v" 'scroll-down) + (keymap-bind! *global-keymap* "C-v" 'scroll-up) (keymap-bind! *global-keymap* "C-l" 'recenter-top-bottom) ;; Arrow keys and navigation @@ -505,14 +505,14 @@ (keymap-bind! *global-keymap* "<right>" 'forward-char) (keymap-bind! *global-keymap* "<home>" 'beginning-of-line) (keymap-bind! *global-keymap* "<end>" 'end-of-line) - (keymap-bind! *global-keymap* "<prior>" 'scroll-up) - (keymap-bind! *global-keymap* "<next>" 'scroll-down) + (keymap-bind! *global-keymap* "<prior>" 'scroll-down) + (keymap-bind! *global-keymap* "<next>" 'scroll-up) (keymap-bind! *global-keymap* "<delete>" 'delete-char) ;; Alt/Meta navigation (keymap-bind! *global-keymap* "M-f" 'forward-word) (keymap-bind! *global-keymap* "M-b" 'backward-word) - (keymap-bind! *global-keymap* "M-v" 'scroll-up) + (keymap-bind! *global-keymap* "M-v" 'scroll-down) (keymap-bind! *global-keymap* "M-<" 'beginning-of-buffer) (keymap-bind! *global-keymap* "M->" 'end-of-buffer) --- a/src/jerboa-emacs/qt/commands-core.ss +++ b/src/jerboa-emacs/qt/commands-core.ss @@ -714,8 +714,8 @@ Returns #t if changed, #f if not or if no record exists." (def (qt-page-lines ed) (max 1 (- (sci-send ed SCI_LINESONSCREEN 0) 1))) -(def (cmd-scroll-down app) - "Page the viewport down without faking cursor movement." +(def (cmd-scroll-up app) + "Page the viewport forward without faking cursor movement." (let* ((ed (current-qt-editor app)) (first (sci-send ed SCI_GETFIRSTVISIBLELINE 0)) (page (qt-page-lines ed)) @@ -724,8 +724,8 @@ Returns #t if changed, #f if not or if no record exists." (sci-send ed SCI_SETFIRSTVISIBLELINE target) (update-mark-region! app ed))) -(def (cmd-scroll-up app) - "Page the viewport up without faking cursor movement." +(def (cmd-scroll-down app) + "Page the viewport backward without faking cursor movement." (let* ((ed (current-qt-editor app)) (first (sci-send ed SCI_GETFIRSTVISIBLELINE 0)) (page (qt-page-lines ed)) --- a/tests/test-qt-part2.ss +++ b/tests/test-qt-part2.ss @@ -91,6 +91,12 @@ (sci-send ed SCI_SETREADONLY 0) (qt-plain-text-edit-set-text! ed "") (values ed w app))) +(define (qt-test-lines n) + (let loop ((i 0) (acc '())) + (if (= i n) + (apply string-append (reverse acc)) + (loop (+ i 1) + (cons (string-append "line " (number->string i) "\n") acc))))) (display "\n=== Qt Part2 Groups 44-56 ===\n") @@ -127,19 +133,29 @@ (check (app-state-last-yank-pos app) => 1) (check (app-state-last-yank-len app) => 1))) -(test-case "group47 scroll commands use Scintilla visible line" +(test-case "group47 scroll commands page the Scintilla viewport" (let-values (((ed w app) (make-qt-test-app "part2-47"))) - (qt-plain-text-edit-set-text! ed "one\ntwo\nthree\nfour\nfive\nsix\nseven\neight\nnine\nten\n") + (qt-plain-text-edit-set-text! ed (qt-test-lines 80)) (sci-send ed SCI_SETFIRSTVISIBLELINE 0) - (execute-command! app 'scroll-up) - (check (integer? (sci-send ed SCI_GETFIRSTVISIBLELINE)) => #t))) - -(test-case "group48 recenter command is callable" + (let* ((page (max 1 (- (sci-send ed SCI_LINESONSCREEN 0) 1))) + (last-first (max 0 (- (qt-plain-text-edit-line-count ed) 1))) + (expected-up (min last-first page))) + (execute-command! app 'scroll-up) + (check (sci-send ed SCI_GETFIRSTVISIBLELINE 0) => expected-up) + (execute-command! app 'scroll-down) + (check (sci-send ed SCI_GETFIRSTVISIBLELINE 0) => 0)))) + +(test-case "group48 recenter centers the cursor line" (let-values (((ed w app) (make-qt-test-app "part2-48"))) - (qt-plain-text-edit-set-text! ed "a\nb\nc\nd\ne\nf\ng\nh\n") - (execute-command! app 'end-of-buffer) - (execute-command! app 'recenter) - (check (integer? (sci-send ed SCI_GETFIRSTVISIBLELINE)) => #t))) + (qt-plain-text-edit-set-text! ed (qt-test-lines 80)) + (let* ((target-line 30) + (pos (sci-send ed SCI_POSITIONFROMLINE target-line 0)) + (rows (max 1 (sci-send ed SCI_LINESONSCREEN 0))) + (expected (max 0 (- target-line (quotient rows 2))))) + (sci-send ed SCI_GOTOPOS pos) + (sci-send ed SCI_SETFIRSTVISIBLELINE 0) + (execute-command! app 'recenter) + (check (sci-send ed SCI_GETFIRSTVISIBLELINE 0) => expected)))) (test-case "group49 line-number toggle command is callable" (let-values (((ed w app) (make-qt-test-app "part2-49")))