Fix chord auto-repeat and top quit in vterm
ober
fb8d72ee3afb37da5ea730edc019e7b25a186007
--- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -1366,7 +1366,6 @@ echo-label)))))]) (cond [*chord-pending-char* - (qt-timer-stop! *chord-timer*) (let* ([ch1 *chord-pending-char*] [saved-code *chord-pending-code*] [saved-mods *chord-pending-mods*] @@ -1389,39 +1388,52 @@ QT_MOD_ALT)) (string-ref text - 0))] - [chord-cmd (and ch2 - (chord-lookup - ch1 - ch2))]) - (set! *chord-pending-char* #f) - (if chord-cmd - (begin - (execute-command! - app - chord-cmd) - (qt-update-visual-decorations! - (qt-current-editor - (app-state-frame - app))) - (qt-update-mark-selection! - app) - (qt-modeline-update! app) - (qt-tabbar-update! app) - (qt-update-frame-title! - app) - (qt-echo-draw! - (app-state-echo app) - echo-label)) - (begin - (do-normal-key! - saved-code - saved-mods - saved-text) - (do-normal-key! - code - mods - text))))] + 0))]) + (if (and ch2 + (char=? ch1 ch2) + (= code saved-code) + (not (chord-lookup + ch1 + ch2))) + (void) + (let ([chord-cmd (and ch2 + (chord-lookup + ch1 + ch2))]) + (qt-timer-stop! + *chord-timer*) + (set! *chord-pending-char* + #f) + (if chord-cmd + (begin + (execute-command! + app + chord-cmd) + (qt-update-visual-decorations! + (qt-current-editor + (app-state-frame + app))) + (qt-update-mark-selection! + app) + (qt-modeline-update! + app) + (qt-tabbar-update! + app) + (qt-update-frame-title! + app) + (qt-echo-draw! + (app-state-echo + app) + echo-label)) + (begin + (do-normal-key! + saved-code + saved-mods + saved-text) + (do-normal-key! + code + mods + text))))))] [(and (= (string-length text) 1) (> (char->integer (string-ref text 0)) @@ -1448,6 +1460,9 @@ cur-buf) (gsh-eshell-buffer? cur-buf))))) + (verbose-log! + "CHORD-PENDING ch=" + (string (string-ref text 0))) (set! *chord-pending-char* (string-ref text 0)) (set! *chord-pending-code* code) --- a/lib/jerboa-emacs/qt/commands-shell.sls +++ b/lib/jerboa-emacs/qt/commands-shell.sls @@ -81,7 +81,7 @@ (jerboa-emacs async) schedule-periodic! cancel-periodic!) - (only (jsh registry) builtin-lookup) + (only (jsh registry) builtin-lookup builtin-register!) (rename (jerboa-coreutils top) (main cu-top-main)) (only (jerboa-emacs persist) theme-settings-save! theme-settings-load! mx-history-save! mx-history-load! @@ -2358,4 +2358,46 @@ (define-syntax *top-active* (identifier-syntax [id (vector-ref *top-active*--cell 0)] - [(set! id val) (vector-set! *top-active*--cell 0 val)]))) + [(set! id val) (vector-set! *top-active*--cell 0 val)])) + (builtin-register! + "top" + (lambda (args env) + (call/cc + (lambda (k) + (parameterize ([exit-handler (lambda (code) (k code))]) + (if (member "-b" args) + (begin (apply cu-top-main args) 0) + (let ([in (current-input-port)]) + (let loop () + (with-catch + (lambda (e) (void)) + (lambda () + (call/cc + (lambda (k2) + (parameterize ([exit-handler + (lambda (code) (k2 (void)))]) + (apply + cu-top-main + (append (list "-b" "-n" "1") args))))))) + (let check () + (if (and (input-port? in) (char-ready? in)) + (let ([ch (read-char in)]) + (cond + [(eof-object? ch) (k 0)] + [(char=? ch #\q) (k 0)] + [(char=? ch (integer->char 3)) (k 0)] + [else (check)])) + (void))) + (let delay-loop ([remaining 30]) + (when (> remaining 0) + (thread-sleep! 0.1) + (if (and (input-port? in) (char-ready? in)) + (let ([ch (read-char in)]) + (cond + [(eof-object? ch) (k 0)] + [(char=? ch #\q) (k 0)] + [(char=? ch (integer->char 3)) (k 0)] + [else (delay-loop (- remaining 1))])) + (delay-loop (- remaining 1))))) + (loop))))))) + 0))) --- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -1118,7 +1118,6 @@ (cond ;; Case 1: A chord is pending and a new key arrived (*chord-pending-char* - (qt-timer-stop! *chord-timer*) (let* ((ch1 *chord-pending-char*) (saved-code *chord-pending-code*) (saved-mods *chord-pending-mods*) @@ -1128,10 +1127,18 @@ (> (char->integer (string-ref text 0)) 31) (zero? (bitwise-and mods QT_MOD_CTRL)) (zero? (bitwise-and mods QT_MOD_ALT)) - (string-ref text 0))) - (chord-cmd (and ch2 (chord-lookup ch1 ch2)))) - (set! *chord-pending-char* #f) - (if chord-cmd + (string-ref text 0)))) + ;; Auto-repeat filter: when same char + same code arrives, + ;; check if it's a valid same-char chord (e.g. EE→eshell). + ;; If not a valid chord, it's auto-repeat — ignore and keep waiting. + (if (and ch2 (char=? ch1 ch2) (= code saved-code) + (not (chord-lookup ch1 ch2))) + (void) ;; ignore auto-repeat, timer keeps running + ;; Real second key — resolve the chord + (let ((chord-cmd (and ch2 (chord-lookup ch1 ch2)))) + (qt-timer-stop! *chord-timer*) + (set! *chord-pending-char* #f) + (if chord-cmd ;; Chord matched — execute the chord command (begin (execute-command! app chord-cmd) @@ -1145,7 +1152,7 @@ ;; No chord — replay saved key then process current key (begin (do-normal-key! saved-code saved-mods saved-text) - (do-normal-key! code mods text))))) + (do-normal-key! code mods text))))))) ;; Case 2: Printable key that could start a chord — save and wait ;; Skip chord detection in terminal/shell buffers to avoid @@ -1160,6 +1167,7 @@ (not (or (terminal-buffer? cur-buf) (shell-buffer? cur-buf) (gsh-eshell-buffer? cur-buf))))) + (verbose-log! "CHORD-PENDING ch=" (string (string-ref text 0))) (set! *chord-pending-char* (string-ref text 0)) (set! *chord-pending-code* code) (set! *chord-pending-mods* mods) --- a/src/jerboa-emacs/qt/commands-shell.ss +++ b/src/jerboa-emacs/qt/commands-shell.ss @@ -12,7 +12,7 @@ :jerboa-emacs/qt/sci-shim :jerboa-emacs/core (only-in :jerboa-emacs/async schedule-periodic! cancel-periodic!) - (only-in :jsh/registry builtin-lookup) + (only-in :jsh/registry builtin-lookup builtin-register!) (rename-in :jerboa-coreutils/top (main cu-top-main)) (only-in :jerboa-emacs/persist theme-settings-save! theme-settings-load! mx-history-save! mx-history-load! @@ -1911,3 +1911,53 @@ SPC = page down, DEL = page up, q = quit view-mode." (set! *top-active* #f) (echo-message! (app-state-echo app) "top stopped")) +;; Register `top` as a jsh builtin for vterm. +;; The coreutils top opens /dev/tty for interactive input, which doesn't +;; work inside vterm (different fd from the PTY). This builtin runs top +;; in batch mode with a loop, using current-input-port (the PTY) for +;; quit detection (q or C-c). +(builtin-register! "top" + (lambda (args env) + (call/cc + (lambda (k) + (parameterize ((exit-handler (lambda (code) (k code)))) + (if (member "-b" args) + ;; User explicitly asked for batch mode — pass through + (begin (apply cu-top-main args) 0) + ;; Interactive-style: batch mode + loop + PTY input for quit + (let ((in (current-input-port))) + (let loop () + ;; Run one batch iteration + (with-catch + (lambda (e) (void)) + (lambda () + (call/cc + (lambda (k2) + (parameterize ((exit-handler (lambda (code) (k2 (void))))) + (apply cu-top-main + (append (list "-b" "-n" "1") args))))))) + ;; Check for quit: q or C-c (char 3) + (let check () + (if (and (input-port? in) (char-ready? in)) + (let ((ch (read-char in))) + (cond + ((eof-object? ch) (k 0)) + ((char=? ch #\q) (k 0)) + ((char=? ch (integer->char 3)) (k 0)) ;; C-c + (else (check)))) ;; drain other chars + (void))) + ;; Sleep 3 seconds, polling for quit every 100ms + (let delay-loop ((remaining 30)) + (when (> remaining 0) + (thread-sleep! 0.1) + (if (and (input-port? in) (char-ready? in)) + (let ((ch (read-char in))) + (cond + ((eof-object? ch) (k 0)) + ((char=? ch #\q) (k 0)) + ((char=? ch (integer->char 3)) (k 0)) + (else (delay-loop (- remaining 1))))) + (delay-loop (- remaining 1))))) + (loop))))))) + 0)) +