Fix vterm horizontal bounce: accurate cols + suppress intermediate paints
ober
5200832e01d5c69e3d6fa19a9cba4ffa59fd2fec
--- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -541,6 +541,7 @@ ts) "") rendered))]) + (qt-widget-set-updates-enabled! ed #f) (qt-plain-text-edit-set-text! ed full) (hash-put! *vterm-last-rendered* ts full) (hash-put! *vterm-initialized* ts #t) @@ -560,7 +561,9 @@ ed QT_CURSOR_END) (qt-plain-text-edit-ensure-cursor-visible! - ed)) + ed) + (sci-send ed SCI_SETXOFFSET 0) + (qt-widget-set-updates-enabled! ed #t)) (when (vtscreen-has-damage? vt) (if (vtscreen-alt-screen? vt) (hash-put! *vterm-line-offset* ts 0) @@ -597,7 +600,11 @@ ed QT_CURSOR_END) (qt-plain-text-edit-ensure-cursor-visible! - ed)))) + ed) + (sci-send + ed + SCI_SETXOFFSET + 0)))) (qt-widget-set-updates-enabled! ed #t)))) @@ -607,7 +614,8 @@ (qt-plain-text-edit-insert-text! ed (strip-ansi-codes data)) - (qt-plain-text-edit-ensure-cursor-visible! ed)))) + (qt-plain-text-edit-ensure-cursor-visible! ed) + (sci-send ed SCI_SETXOFFSET 0)))) (loop (cdr wins))))))) (def (qt-poll-terminal-pty-msg! fr buf ts msg) "Handle one PTY message for a terminal buffer in Qt.\n Data messages are handled via qt-poll-terminal-pty-batch! for efficiency." @@ -629,27 +637,26 @@ (if (eq? (qt-edit-window-buffer (car wins)) buf) (let ([ed (qt-edit-window-editor (car wins))]) (let ([prompt (terminal-prompt ts)]) - (when pre-text - (if alt-screen? - (qt-plain-text-edit-set-text! ed pre-text) - (let* ([output (or final-render "")] - [sep (if (and (> (string-length - output) - 0) - (not (char=? - (string-ref - output - (- (string-length - output) - 1)) - #\newline))) - "\n" - "")] - [full (string-append - pre-text - output - sep)]) - (qt-plain-text-edit-set-text! ed full)))) + (qt-widget-set-updates-enabled! ed #f) + (if (and pre-text alt-screen?) + (qt-plain-text-edit-set-text! ed pre-text) + (begin + (qt-plain-text-edit-move-cursor! + ed + QT_CURSOR_END) + (let ([text (qt-plain-text-edit-text ed)]) + (when (and text + (> (string-length text) 0) + (not (char=? + (string-ref + text + (- (string-length + text) + 1)) + #\newline))) + (qt-plain-text-edit-insert-text! + ed + "\n"))))) (qt-plain-text-edit-move-cursor! ed QT_CURSOR_END) @@ -657,7 +664,9 @@ (terminal-state-prompt-pos-set! ts (string-length (qt-plain-text-edit-text ed))) - (qt-plain-text-edit-ensure-cursor-visible! ed))) + (qt-plain-text-edit-ensure-cursor-visible! ed) + (sci-send ed SCI_SETXOFFSET 0) + (qt-widget-set-updates-enabled! ed #t))) (loop (cdr wins))))))]))) (def (qt-do-init! qt-app args) (init-jemacs-log!) (init-verbose-log!) --- a/lib/jerboa-emacs/qt/commands-config.sls +++ b/lib/jerboa-emacs/qt/commands-config.sls @@ -924,7 +924,15 @@ "")] [rows (max 2 (sci-send ed 2370 0))] [widget-w (qt-widget-width ed)] - [cols (max 20 (quotient widget-w 8))]) + [margin-w (sci-send ed SCI_GETMARGINWIDTHN 0)] + [text-w (- widget-w margin-w 16)] + [char-w (let ([w (sci-send/string + ed + 2276 + "M" + STYLE_DEFAULT)]) + (if (> w 0) w 8))] + [cols (max 20 (quotient text-w char-w))]) (verbose-log! "cmd-terminal-send: input=" input " rows=" (number->string rows) " cols=" (number->string cols)) (let ([trimmed-input (safe-string-trim-both input)]) --- a/lib/jerboa-emacs/qt/commands-shell.sls +++ b/lib/jerboa-emacs/qt/commands-shell.sls @@ -2209,58 +2209,50 @@ (cancel-periodic! 'top-refresh) (set! *top-active* #f) (echo-message! (app-state-echo app) "top stopped")) (def (vterm-start-top! ts ed _fr cmd-string) - "Run coreutils top inside the current vterm buffer using a virtual PTY.\n Uses alt-screen + row-diff rendering for performant, flicker-free display.\n Input (q/C-c to quit) flows through terminal-send-input! via the input box." - (let* ([esc (string (integer->char 27))] - [alt-screen-on (string-append esc "[?1049h")] - [alt-screen-off (string-append esc "[?1049l")] - [clear-home (string-append esc "[2J" esc "[H")] - [ch (make-channel)] - [input-box (box "")] - [vt (new-vtscreen 24 80)]) + "Run coreutils top inside the current vterm buffer.\n Uses direct text replacement for flicker-free display.\n Input (q/C-c to quit) flows through terminal-send-input! via the input box." + (let* ([input-box (box "")] + [running (box #t)] + [pre-text (qt-plain-text-edit-text ed)]) (terminal-state-pty-master-set! ts input-box) (terminal-state-pty-pid-set! ts 'top) - (terminal-state-pty-channel-set! ts ch) - (terminal-state-vtscreen-set! ts vt) - (let ([thread (spawn - (lambda () - (with-catch - (lambda (e) (channel-put ch (cons 'done -1))) - (lambda () - (channel-put ch (cons 'data alt-screen-on)) - (let loop () - (channel-put ch (cons 'data clear-home)) - (let ([output (top-capture-output)]) - (channel-put ch (cons 'data output))) - (let ([pending (unbox input-box)]) - (set-box! input-box "") - (if (top-input-quit? pending) - (begin - (channel-put - ch - (cons 'data alt-screen-off)) - (channel-put ch (cons 'done 0))) - (let delay ([remaining 30]) - (if (<= remaining 0) - (loop) - (begin - (thread-sleep! 0.1) - (let ([p (unbox input-box)]) - (if (top-input-quit? p) - (begin - (set-box! - input-box - "") - (channel-put - ch - (cons - 'data - alt-screen-off)) - (channel-put - ch - (cons 'done 0))) - (delay (- remaining - 1))))))))))))))]) - (terminal-state-pty-thread-set! ts thread)))) + (terminal-state-pre-pty-text-set! ts pre-text) + (schedule-periodic! + 'vterm-top + 3000 + (lambda () + (when (unbox running) + (let ([pending (unbox input-box)]) + (set-box! input-box "") + (if (top-input-quit? pending) + (begin + (set-box! running #f) + (cancel-periodic! 'vterm-top) + (terminal-state-pty-master-set! ts #f) + (terminal-state-pty-pid-set! ts #f) + (terminal-state-pre-pty-text-set! ts #f) + (qt-plain-text-edit-set-text! ed pre-text) + (qt-plain-text-edit-move-cursor! ed QT_CURSOR_END) + (let ([prompt (terminal-prompt ts)]) + (qt-plain-text-edit-insert-text! ed prompt) + (terminal-state-prompt-pos-set! + ts + (string-length (qt-plain-text-edit-text ed))) + (qt-plain-text-edit-ensure-cursor-visible! ed))) + (let ([output (top-capture-output)] + [cursor-pos (qt-plain-text-edit-cursor-position + ed)]) + (qt-widget-set-updates-enabled! ed #f) + (qt-plain-text-edit-set-text! ed output) + (when (< cursor-pos (string-length output)) + (qt-plain-text-edit-set-cursor-position! + ed + cursor-pos)) + (qt-widget-set-updates-enabled! ed #t))))))) + (let ([output (top-capture-output)]) + (qt-widget-set-updates-enabled! ed #f) + (qt-plain-text-edit-set-text! ed output) + (qt-plain-text-edit-set-cursor-position! ed 0) + (qt-widget-set-updates-enabled! ed #t)))) (def (top-input-quit? str) "Check if input string contains q or C-c (quit signal for top)." (let ([len (string-length str)]) --- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -572,12 +572,17 @@ ;; Only render to the widget if enough time has elapsed (when (vterm-render-due? ts) (if (not (hash-ref *vterm-initialized* ts #f)) - ;; First render: full set-text to establish the document + ;; First render: full set-text to establish the document. + ;; Wrap in set-updates-enabled #f/#t to prevent bounce: + ;; set-text! resets scroll to top, then ensure-cursor-visible + ;; scrolls to bottom — without suppressing updates, both + ;; paints are visible as a flash/bounce. (let* ((rendered (vtscreen-render vt)) (full (if (vtscreen-alt-screen? vt) rendered (string-append (or (terminal-state-pre-pty-text ts) "") rendered)))) + (qt-widget-set-updates-enabled! ed #f) (qt-plain-text-edit-set-text! ed full) (hash-put! *vterm-last-rendered* ts full) (hash-put! *vterm-initialized* ts #t) @@ -593,7 +598,10 @@ ;; Apply colors to initial render (vterm-apply-colors! ed vt ts) (qt-plain-text-edit-move-cursor! ed QT_CURSOR_END) - (qt-plain-text-edit-ensure-cursor-visible! ed)) + (qt-plain-text-edit-ensure-cursor-visible! ed) + ;; Reset horizontal scroll — terminal never needs h-scroll + (sci-send ed SCI_SETXOFFSET 0) + (qt-widget-set-updates-enabled! ed #t)) ;; Subsequent renders: row-diff update (when (vtscreen-has-damage? vt) (if (vtscreen-alt-screen? vt) @@ -624,13 +632,16 @@ ;; Normal mode: scroll to bottom to follow output (begin (qt-plain-text-edit-move-cursor! ed QT_CURSOR_END) - (qt-plain-text-edit-ensure-cursor-visible! ed)))) + (qt-plain-text-edit-ensure-cursor-visible! ed) + ;; Reset horizontal scroll — terminal never needs h-scroll + (sci-send ed SCI_SETXOFFSET 0)))) (qt-widget-set-updates-enabled! ed #t)))) (vterm-mark-rendered! ts))) (begin (qt-plain-text-edit-move-cursor! ed QT_CURSOR_END) (qt-plain-text-edit-insert-text! ed (strip-ansi-codes data)) - (qt-plain-text-edit-ensure-cursor-visible! ed)))) + (qt-plain-text-edit-ensure-cursor-visible! ed) + (sci-send ed SCI_SETXOFFSET 0)))) (loop (cdr wins))))))) (def (qt-poll-terminal-pty-msg! fr buf ts msg) @@ -656,22 +667,30 @@ (if (eq? (qt-edit-window-buffer (car wins)) buf) (let ((ed (qt-edit-window-editor (car wins)))) (let ((prompt (terminal-prompt ts))) - (when pre-text - (if alt-screen? - ;; Full-screen program (top, vim): restore pre-PTY text - (qt-plain-text-edit-set-text! ed pre-text) - ;; Simple command (ls, ps): keep output - (let* ((output (or final-render "")) - (sep (if (and (> (string-length output) 0) - (not (char=? (string-ref output (- (string-length output) 1)) #\newline))) - "\n" "")) - (full (string-append pre-text output sep))) - (qt-plain-text-edit-set-text! ed full)))) + ;; Suppress widget updates during done-handler edits + ;; to prevent bounce (multiple paints during set-text/insert/scroll). + (qt-widget-set-updates-enabled! ed #f) + (if (and pre-text alt-screen?) + ;; Full-screen program (top, vim): restore pre-PTY text + (qt-plain-text-edit-set-text! ed pre-text) + ;; Simple command (ls, ps): keep current editor content as-is. + ;; Row-diff rendering already updated the display incrementally; + ;; do NOT call set-text! again (causes visible bounce/flash). + (begin + (qt-plain-text-edit-move-cursor! ed QT_CURSOR_END) + ;; Ensure trailing newline before prompt + (let ((text (qt-plain-text-edit-text ed))) + (when (and text (> (string-length text) 0) + (not (char=? (string-ref text (- (string-length text) 1)) #\newline))) + (qt-plain-text-edit-insert-text! ed "\n"))))) (qt-plain-text-edit-move-cursor! ed QT_CURSOR_END) (qt-plain-text-edit-insert-text! ed prompt) (set! (terminal-state-prompt-pos ts) (string-length (qt-plain-text-edit-text ed))) - (qt-plain-text-edit-ensure-cursor-visible! ed))) + (qt-plain-text-edit-ensure-cursor-visible! ed) + ;; Reset horizontal scroll — terminal never needs h-scroll + (sci-send ed SCI_SETXOFFSET 0) + (qt-widget-set-updates-enabled! ed #t))) (loop (cdr wins)))))))))) (def (qt-do-init! qt-app args) --- a/src/jerboa-emacs/qt/commands-config.ss +++ b/src/jerboa-emacs/qt/commands-config.ss @@ -757,10 +757,16 @@ modified so the next save uses the new encoding." "")) ;; Compute actual terminal dimensions from editor widget (rows (max 2 (sci-send ed 2370 0))) ; SCI_LINESONSCREEN - ;; Use SCI_GETCOLUMN on the last position of a long line to - ;; estimate visible columns, or fall back to widget width / 8. + ;; Measure actual character width via SCI_TEXTWIDTH (2276) + ;; with STYLE_DEFAULT (32), then divide usable text area by it. + ;; Subtract line-number margin and scrollbar so terminal output + ;; never exceeds the visible area (prevents horizontal bounce). (widget-w (qt-widget-width ed)) - (cols (max 20 (quotient widget-w 8)))) + (margin-w (sci-send ed SCI_GETMARGINWIDTHN 0)) ; line number margin + (text-w (- widget-w margin-w 16)) ; 16px for vertical scrollbar + (char-w (let ((w (sci-send/string ed 2276 "M" STYLE_DEFAULT))) + (if (> w 0) w 8))) + (cols (max 20 (quotient text-w char-w)))) (verbose-log! "cmd-terminal-send: input=" input " rows=" (number->string rows) " cols=" (number->string cols)) ;; Record command in shared history --- a/src/jerboa-emacs/qt/commands-shell.ss +++ b/src/jerboa-emacs/qt/commands-shell.ss @@ -1915,58 +1915,53 @@ SPC = page down, DEL = page up, q = quit view-mode." (echo-message! (app-state-echo app) "top stopped")) (def (vterm-start-top! ts ed _fr cmd-string) - "Run coreutils top inside the current vterm buffer using a virtual PTY. - Uses alt-screen + row-diff rendering for performant, flicker-free display. + "Run coreutils top inside the current vterm buffer. + Uses direct text replacement for flicker-free display. Input (q/C-c to quit) flows through terminal-send-input! via the input box." - (let* ((esc (string (integer->char 27))) - (alt-screen-on (string-append esc "[?1049h")) - (alt-screen-off (string-append esc "[?1049l")) - (clear-home (string-append esc "[2J" esc "[H")) - (ch (make-channel)) - (input-box (box "")) - (vt (new-vtscreen 24 80))) + (let* ((input-box (box "")) + (running (box #t)) + (pre-text (qt-plain-text-edit-text ed))) ;; Set up virtual PTY state — input-box as master, 'top as pid (set! (terminal-state-pty-master ts) input-box) (set! (terminal-state-pty-pid ts) 'top) - (set! (terminal-state-pty-channel ts) ch) - (set! (terminal-state-vtscreen ts) vt) - ;; Spawn background thread that loops coreutils top - (let ((thread - (spawn - (lambda () - (with-catch - (lambda (e) (channel-put ch (cons 'done -1))) - (lambda () - ;; Switch to alt screen - (channel-put ch (cons 'data alt-screen-on)) - (let loop () - ;; Clear screen + cursor home - (channel-put ch (cons 'data clear-home)) - ;; Capture top -b -n 1 output - (let ((output (top-capture-output))) - (channel-put ch (cons 'data output))) - ;; Check input box for quit chars (q or C-c) - (let ((pending (unbox input-box))) - (set-box! input-box "") - (if (top-input-quit? pending) - ;; Quit: restore normal screen, signal done - (begin - (channel-put ch (cons 'data alt-screen-off)) - (channel-put ch (cons 'done 0))) - ;; Sleep ~3 seconds, polling input every 100ms - (let delay ((remaining 30)) - (if (<= remaining 0) - (loop) - (begin - (thread-sleep! 0.1) - (let ((p (unbox input-box))) - (if (top-input-quit? p) - (begin - (set-box! input-box "") - (channel-put ch (cons 'data alt-screen-off)) - (channel-put ch (cons 'done 0))) - (delay (- remaining 1)))))))))))))))) - (set! (terminal-state-pty-thread ts) thread)))) + (set! (terminal-state-pre-pty-text ts) pre-text) + ;; Use schedule-periodic! for UI-thread rendering (no vtscreen needed) + (schedule-periodic! 'vterm-top 3000 + (lambda () + (when (unbox running) + ;; Check for quit input + (let ((pending (unbox input-box))) + (set-box! input-box "") + (if (top-input-quit? pending) + ;; Quit: restore terminal + (begin + (set-box! running #f) + (cancel-periodic! 'vterm-top) + (set! (terminal-state-pty-master ts) #f) + (set! (terminal-state-pty-pid ts) #f) + (set! (terminal-state-pre-pty-text ts) #f) + ;; Restore previous text + prompt + (qt-plain-text-edit-set-text! ed pre-text) + (qt-plain-text-edit-move-cursor! ed QT_CURSOR_END) + (let ((prompt (terminal-prompt ts))) + (qt-plain-text-edit-insert-text! ed prompt) + (set! (terminal-state-prompt-pos ts) + (string-length (qt-plain-text-edit-text ed))) + (qt-plain-text-edit-ensure-cursor-visible! ed))) + ;; Render top output + (let ((output (top-capture-output)) + (cursor-pos (qt-plain-text-edit-cursor-position ed))) + (qt-widget-set-updates-enabled! ed #f) + (qt-plain-text-edit-set-text! ed output) + (when (< cursor-pos (string-length output)) + (qt-plain-text-edit-set-cursor-position! ed cursor-pos)) + (qt-widget-set-updates-enabled! ed #t))))))) + ;; Do initial render immediately + (let ((output (top-capture-output))) + (qt-widget-set-updates-enabled! ed #f) + (qt-plain-text-edit-set-text! ed output) + (qt-plain-text-edit-set-cursor-position! ed 0) + (qt-widget-set-updates-enabled! ed #t)))) (def (top-input-quit? str) "Check if input string contains q or C-c (quit signal for top)."