updates
ober
3e042bf823241de0f280b9df75c8197758be1ff4
--- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -381,6 +381,62 @@ (def *chord-pending-text* #f) (def *chord-pending-term* #f) (def *chord-timer-fired* #f) + (def (vterm-session-mapped? session) + "Is SESSION still a live entry in *terminal-widget-map*?\n Used to avoid forwarding a deferred chord key to a destroyed QTerminalSession\n (a freed pointer would crash)." + (let ([found #f]) + (hash-for-each + (lambda (buf s) (when (eq? s session) (set! found #t))) + *terminal-widget-map*) + found)) + (def *vterm-observed-running* (make-hash-table-eq)) + (def (qt-reap-one-vterm! app buf session) + "Tear down a single native vterm BUF whose SESSION has exited." + (let* ([fr (app-state-frame app)] + [other (let loop ([bs (buffer-list)]) + (cond + [(null? bs) #f] + [(eq? (car bs) buf) (loop (cdr bs))] + [else (car bs)]))]) + (when other + (when (eq? *chord-pending-term* session) + (when *chord-timer* (qt-timer-stop! *chord-timer*)) + (set! *chord-pending-char* #f) + (set! *chord-pending-term* #f)) + (for-each + (lambda (win) + (when (eq? (qt-edit-window-buffer win) buf) + (qt-buffer-attach! (qt-edit-window-editor win) other) + (qt-edit-window-buffer-set! win other))) + (qt-frame-windows fr)) + (with-catch + (lambda (e) #f) + (lambda () (qt-terminal-destroy! session))) + (hash-remove! *terminal-widget-map* buf) + (hash-remove! *terminal-views-map* buf) + (hash-remove! *vterm-observed-running* buf) + (qt-buffer-kill! buf) + (echo-message! + (app-state-echo app) + (string-append (buffer-name buf) " exited")) + (qt-modeline-update! app) + (qt-tabbar-update! app) + (qt-update-frame-title! app)))) + (def (qt-reap-dead-vterms! app) + "Close native vterm buffers whose shell process has exited." + (let ([dead '()]) + (hash-for-each + (lambda (buf session) + (cond + [(not session) (void)] + [(qt-terminal-is-running? session) + (hash-put! *vterm-observed-running* buf #t)] + [(hash-get *vterm-observed-running* buf) + (set! dead (cons (cons buf session) dead))] + [else (void)])) + *terminal-widget-map*) + (for-each + (lambda (bs) (qt-reap-one-vterm! app (car bs) (cdr bs))) + dead))) (def *tab-bar-layout* #f) (def *tab-bar-buttons* '()) (def *tab-bar-last-state* #f) @@ -2444,34 +2500,37 @@ (set! *chord-pending-char* #f) (set! *chord-pending-term* #f) (set! *chord-timer-fired* #t) - (if saved-term - (qt-terminal-send-key-event! - saved-term - saved-code - saved-mods - (or saved-text "")) - (let-values ([(action data new-state) - (qt-key-state-feed! - (app-state-key-state app) - saved-code - saved-mods - saved-text)]) - (app-state-key-state-set! app new-state) - (case action - [(self-insert) - (let* ([buf (qt-current-buffer - (app-state-frame app))] - [mode-cmd (mode-keymap-lookup buf data)]) - (if mode-cmd - (execute-command! app mode-cmd) - (let* ([ed (qt-current-editor - (app-state-frame app))] - [ch (string-ref data 0)]) - (qt-plain-text-edit-insert-text! - ed - (string ch)))))] - [(command) (execute-command! app data)] - [else (void)]))) + (cond + [(and saved-term (vterm-session-mapped? saved-term)) + (qt-terminal-send-key-event! + saved-term + saved-code + saved-mods + (or saved-text ""))] + [saved-term (void)] + [else + (let-values ([(action data new-state) + (qt-key-state-feed! + (app-state-key-state app) + saved-code + saved-mods + saved-text)]) + (app-state-key-state-set! app new-state) + (case action + [(self-insert) + (let* ([buf (qt-current-buffer + (app-state-frame app))] + [mode-cmd (mode-keymap-lookup buf data)]) + (if mode-cmd + (execute-command! app mode-cmd) + (let* ([ed (qt-current-editor + (app-state-frame app))] + [ch (string-ref data 0)]) + (qt-plain-text-edit-insert-text! + ed + (string ch)))))] + [(command) (execute-command! app data)] + [else (void)]))]) (qt-update-visual-decorations! (qt-current-editor (app-state-frame app))) (qt-modeline-update! app) @@ -2725,6 +2784,10 @@ (for-each (lambda (f) (qt-open-file! app f)) (ipc-poll-files!)))) + (schedule-periodic! + 'vterm-reaper + 300 + (lambda () (qt-reap-dead-vterms! app))) (set! *master-timer-tick-fn* (lambda () (qt-drain-pending-callbacks!) --- a/lib/jerboa-emacs/qt/commands-shell.sls +++ b/lib/jerboa-emacs/qt/commands-shell.sls @@ -93,8 +93,10 @@ (jerboa-emacs editor) (jerboa-emacs repl) (jerboa-emacs eshell) (jerboa-emacs shell) (jerboa-emacs terminal) (jerboa-emacs qt buffer) - (jerboa-emacs qt window) (jerboa-emacs qt echo) - (jerboa-emacs qt highlight) (jerboa-emacs qt modeline) + (jerboa-emacs qt window) + (only (jerboa-emacs qt menubar) qt-toolbar-toggle!) + (jerboa-emacs qt echo) (jerboa-emacs qt highlight) + (jerboa-emacs qt modeline) (only (jerboa-emacs qt magit) magit-run-git @@ -769,7 +771,10 @@ (cmd-toggle-menu-bar app)) (def (cmd-toggle-tool-bar app) "Toggle toolbar visibility." - (echo-message! (app-state-echo app) "Toolbar toggled")) + (let ([on (qt-toolbar-toggle!)]) + (echo-message! + (app-state-echo app) + (if on "Toolbar shown" "Toolbar hidden")))) (define *scroll-bar-visible*--cell (vector #t)) (def (cmd-toggle-scroll-bar app) "Toggle vertical scrollbar visibility." --- a/lib/jerboa-emacs/qt/commands.sls +++ b/lib/jerboa-emacs/qt/commands.sls @@ -65,9 +65,10 @@ (jerboa-emacs gsh-eshell) (jerboa-emacs shell) (jerboa-emacs shell-history) (jerboa-emacs terminal) (jerboa-emacs chat) (jerboa-emacs qt buffer) - (jerboa-emacs qt window) (jerboa-emacs qt echo) - (jerboa-emacs qt highlight) (jerboa-emacs qt modeline) - (jerboa-emacs qt image) (jerboa-emacs qt commands-core) + (jerboa-emacs qt window) (jerboa-emacs qt menubar) + (jerboa-emacs qt echo) (jerboa-emacs qt highlight) + (jerboa-emacs qt modeline) (jerboa-emacs qt image) + (jerboa-emacs qt commands-core) (jerboa-emacs qt commands-core2) (jerboa-emacs qt commands-edit) (jerboa-emacs qt commands-edit2) @@ -3564,10 +3565,11 @@ "Tree-sitter highlighting: on" "Tree-sitter highlighting: off"))) (def (cmd-tool-bar-mode app) - "Toggle tool bar (Qt)." - (echo-message! - (app-state-echo app) - "Tool bar: not implemented (use M-x for commands)")) + "Toggle the tool bar (Qt)." + (let ([on (qt-toolbar-toggle!)]) + (echo-message! + (app-state-echo app) + (if on "Tool-bar mode enabled" "Tool-bar mode disabled")))) (def (cmd-scroll-bar-mode app) "Toggle scroll bars (vertical and horizontal)." (let* ([ed (current-qt-editor app)] --- a/lib/jerboa-emacs/qt/menubar.sls +++ b/lib/jerboa-emacs/qt/menubar.sls @@ -3,7 +3,10 @@ ;;; Source: src/jerboa-emacs/qt/menubar.ss (library (jerboa-emacs qt menubar) - (export qt-setup-menubar!) + (export + qt-setup-menubar! + qt-toolbar-toggle! + qt-toolbar-visible?) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -11,6 +14,19 @@ (std sugar) (jerboa-emacs qt sci-shim) (jerboa-emacs core) (jerboa core) (jerboa runtime)) (def *menu-command-running?* #f) + (def *qt-main-toolbar* #f) + (def *qt-toolbar-visible?* #t) + (def (qt-toolbar-visible?) + "Return #t if the main toolbar is currently shown." + *qt-toolbar-visible?*) + (def (qt-toolbar-toggle!) + "Toggle the main toolbar's visibility. Returns the new visibility (#t shown)." + (set! *qt-toolbar-visible?* (not *qt-toolbar-visible?*)) + (when *qt-main-toolbar* + (if *qt-toolbar-visible?* + (qt-widget-show! *qt-main-toolbar*) + (qt-widget-hide! *qt-main-toolbar*))) + *qt-toolbar-visible?*) (def (qt-setup-menubar! app win) "Set up the menu bar and toolbar for the main window." (let ([menu-bar (qt-main-window-menu-bar win)]) @@ -80,6 +96,8 @@ (add-menu-command! menu win app "List &Bindings" "Ctrl+H,B" 'list-bindings)) (let ([toolbar (qt-toolbar-create "Main" win)]) + (set! *qt-main-toolbar* toolbar) + (set! *qt-toolbar-visible?* #t) (qt-main-window-add-toolbar! win toolbar) (qt-toolbar-set-movable! toolbar #f) (add-toolbar-command! toolbar win app "New" 'find-file) --- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -441,6 +441,83 @@ (def *chord-pending-term* #f) ;; terminal widget the pending key came from, or #f (def *chord-timer-fired* #f) ;; set to #t when timer fires (guards against race) +(def (vterm-session-mapped? session) + "Is SESSION still a live entry in *terminal-widget-map*? + Used to avoid forwarding a deferred chord key to a destroyed QTerminalSession + (a freed pointer would crash)." + (let ((found #f)) + (hash-for-each + (lambda (buf s) (when (eq? s session) (set! found #t))) + *terminal-widget-map*) + found)) + +;;;============================================================================ +;;; Native vterm reaping — close terminal buffers whose shell has exited +;;;============================================================================ +;; A native QTerminalSession (cmd-term/'vterm) sends C-d straight to the PTY, +;; so the shell receives EOF and exits, but nothing on the Scheme side notices: +;; the buffer lingers and keeps swallowing keystrokes (including chords). The +;; C++ session sets m_running=false on child exit; we poll that here and close +;; the dead buffer, switching any window showing it to another buffer. +;; +;; *vterm-observed-running* guards the create→spawn window: a freshly created +;; session reports not-running until jsh starts, and must not be reaped before +;; it has ever run. +(def *vterm-observed-running* (make-hash-table-eq)) + +(def (qt-reap-one-vterm! app buf session) + "Tear down a single native vterm BUF whose SESSION has exited." + (let* ((fr (app-state-frame app)) + (other (let loop ((bs (buffer-list))) + (cond ((null? bs) #f) + ((eq? (car bs) buf) (loop (cdr bs))) + (else (car bs)))))) + ;; Only reap when there is somewhere to switch the window(s) to. + (when other + ;; Drop any chord key still pending from this terminal so the timer + ;; never forwards to the about-to-be-destroyed session. + (when (eq? *chord-pending-term* session) + (when *chord-timer* (qt-timer-stop! *chord-timer*)) + (set! *chord-pending-char* #f) + (set! *chord-pending-term* #f)) + ;; Reassign every window showing this buffer to another buffer. + (for-each + (lambda (win) + (when (eq? (qt-edit-window-buffer win) buf) + (qt-buffer-attach! (qt-edit-window-editor win) other) + (set! (qt-edit-window-buffer win) other))) + (qt-frame-windows fr)) + ;; Destroy the session (detaches + frees every view and the PTY), then + ;; clean the maps and kill the buffer. + (with-catch (lambda (e) #f) + (lambda () (qt-terminal-destroy! session))) + (hash-remove! *terminal-widget-map* buf) + (hash-remove! *terminal-views-map* buf) + (hash-remove! *vterm-observed-running* buf) + (qt-buffer-kill! buf) + (echo-message! (app-state-echo app) + (string-append (buffer-name buf) " exited")) + (qt-modeline-update! app) + (qt-tabbar-update! app) + (qt-update-frame-title! app)))) + +(def (qt-reap-dead-vterms! app) + "Close native vterm buffers whose shell process has exited." + (let ((dead '())) + (hash-for-each + (lambda (buf session) + (cond + ((not session) (void)) + ((qt-terminal-is-running? session) + (hash-put! *vterm-observed-running* buf #t)) + ((hash-get *vterm-observed-running* buf) + (set! dead (cons (cons buf session) dead))) + (else (void)))) ;; created but never spawned yet — leave alone + *terminal-widget-map*) + (for-each + (lambda (bs) (qt-reap-one-vterm! app (car bs) (cdr bs))) + dead))) + ;; Tab bar state — populated during qt-main, used by qt-tabbar-update! (def *tab-bar-layout* #f) (def *tab-bar-buttons* '()) ;; list of (buffer . button) pairs @@ -1827,27 +1904,32 @@ (set! *chord-pending-char* #f) (set! *chord-pending-term* #f) (set! *chord-timer-fired* #t) - (if saved-term - ;; Pending key came from a terminal — forward it to the PTY widget - ;; instead of replaying it into an editor buffer. - (qt-terminal-send-key-event! saved-term saved-code saved-mods (or saved-text "")) + (cond + ;; Pending key came from a terminal that is still alive — forward + ;; it to the PTY widget instead of replaying into an editor buffer. + ((and saved-term (vterm-session-mapped? saved-term)) + (qt-terminal-send-key-event! saved-term saved-code saved-mods (or saved-text ""))) + ;; Terminal went away (shell exited / buffer reaped) — drop the key + ;; rather than forward to a freed session or self-insert it. + (saved-term (void)) ;; Otherwise replay the pending key through normal key processing - (let-values (((action data new-state) - (qt-key-state-feed! (app-state-key-state app) - saved-code saved-mods saved-text))) - (set! (app-state-key-state app) new-state) - (case action - ((self-insert) - (let* ((buf (qt-current-buffer (app-state-frame app))) - (mode-cmd (mode-keymap-lookup buf data))) - (if mode-cmd - (execute-command! app mode-cmd) - (let* ((ed (qt-current-editor (app-state-frame app))) - (ch (string-ref data 0))) - (qt-plain-text-edit-insert-text! ed (string ch)))))) - ((command) - (execute-command! app data)) - (else (void))))) + (else + (let-values (((action data new-state) + (qt-key-state-feed! (app-state-key-state app) + saved-code saved-mods saved-text))) + (set! (app-state-key-state app) new-state) + (case action + ((self-insert) + (let* ((buf (qt-current-buffer (app-state-frame app))) + (mode-cmd (mode-keymap-lookup buf data))) + (if mode-cmd + (execute-command! app mode-cmd) + (let* ((ed (qt-current-editor (app-state-frame app))) + (ch (string-ref data 0))) + (qt-plain-text-edit-insert-text! ed (string ch)))))) + ((command) + (execute-command! app data)) + (else (void)))))) ;; Update UI (both paths) (qt-update-visual-decorations! (qt-current-editor (app-state-frame app))) @@ -2093,6 +2175,11 @@ (for-each (lambda (f) (qt-open-file! app f)) (ipc-poll-files!)))) + ;; Reap native vterm buffers whose shell has exited (C-d, `exit`, crash) so + ;; the dead terminal does not linger and swallow keystrokes (incl. chords). + (schedule-periodic! 'vterm-reaper 300 + (lambda () (qt-reap-dead-vterms! app))) + ;; Master timer tick function — passed to qt-app-exec! as the per-iteration ;; callback so all periodic work runs on the primordial thread. ;; This eliminates the second Chez thread entirely, preventing GC --- a/src/jerboa-emacs/qt/commands-shell.ss +++ b/src/jerboa-emacs/qt/commands-shell.ss @@ -26,6 +26,7 @@ :jerboa-emacs/terminal :jerboa-emacs/qt/buffer :jerboa-emacs/qt/window + (only-in :jerboa-emacs/qt/menubar qt-toolbar-toggle!) :jerboa-emacs/qt/echo :jerboa-emacs/qt/highlight :jerboa-emacs/qt/modeline @@ -708,7 +709,9 @@ SPC = page down, DEL = page up, q = quit view-mode." (def (cmd-toggle-tool-bar app) "Toggle toolbar visibility." - (echo-message! (app-state-echo app) "Toolbar toggled")) + (let ((on (qt-toolbar-toggle!))) + (echo-message! (app-state-echo app) + (if on "Toolbar shown" "Toolbar hidden")))) (def *scroll-bar-visible* #t) --- a/src/jerboa-emacs/qt/commands.ss +++ b/src/jerboa-emacs/qt/commands.ss @@ -132,6 +132,7 @@ :jerboa-emacs/chat :jerboa-emacs/qt/buffer :jerboa-emacs/qt/window + :jerboa-emacs/qt/menubar :jerboa-emacs/qt/echo :jerboa-emacs/qt/highlight :jerboa-emacs/qt/modeline @@ -3017,8 +3018,10 @@ ;; all defined in commands-shell.ss (available via (export #t) chain) (def (cmd-tool-bar-mode app) - "Toggle tool bar (Qt)." - (echo-message! (app-state-echo app) "Tool bar: not implemented (use M-x for commands)")) + "Toggle the tool bar (Qt)." + (let ((on (qt-toolbar-toggle!))) + (echo-message! (app-state-echo app) + (if on "Tool-bar mode enabled" "Tool-bar mode disabled")))) (def (cmd-scroll-bar-mode app) "Toggle scroll bars (vertical and horizontal)." --- a/src/jerboa-emacs/qt/menubar.ss +++ b/src/jerboa-emacs/qt/menubar.ss @@ -1,7 +1,7 @@ ;;; -*- Gerbil -*- ;;; Qt menu bar and toolbar for jemacs -(export qt-setup-menubar!) +(export qt-setup-menubar! qt-toolbar-toggle! qt-toolbar-visible?) (import :std/sugar :jerboa-emacs/qt/sci-shim @@ -11,6 +11,25 @@ ;; is already running (e.g. narrowing minibuffer calling process-events). (def *menu-command-running?* #f) +;; The main toolbar created by qt-setup-menubar!, kept here so commands +;; (tool-bar-mode / toggle-tool-bar) can show/hide it. Qt shows toolbars +;; by default once added, so visibility starts #t. +(def *qt-main-toolbar* #f) +(def *qt-toolbar-visible?* #t) + +(def (qt-toolbar-visible?) + "Return #t if the main toolbar is currently shown." + *qt-toolbar-visible?*) + +(def (qt-toolbar-toggle!) + "Toggle the main toolbar's visibility. Returns the new visibility (#t shown)." + (set! *qt-toolbar-visible?* (not *qt-toolbar-visible?*)) + (when *qt-main-toolbar* + (if *qt-toolbar-visible?* + (qt-widget-show! *qt-main-toolbar*) + (qt-widget-hide! *qt-main-toolbar*))) + *qt-toolbar-visible?*) + ;;;============================================================================ ;;; Menu bar setup ;;;============================================================================ @@ -75,6 +94,8 @@ ;; ---- Toolbar ---- (let ((toolbar (qt-toolbar-create "Main" win))) + (set! *qt-main-toolbar* toolbar) + (set! *qt-toolbar-visible?* #t) (qt-main-window-add-toolbar! win toolbar) (qt-toolbar-set-movable! toolbar #f) (add-toolbar-command! toolbar win app "New" 'find-file) --- a/support/vendor-overrides/qt_shim.cpp +++ b/support/vendor-overrides/qt_shim.cpp @@ -8054,14 +8054,37 @@ void QTerminalSession::viewFocusedIn(QTerminalView* v) { } void QTerminalSession::viewResized(QTerminalView* v) { + // Recompute only when the active (focused) view changes size. resizeToActive() + // then sizes the grid to the LARGEST view, so a focused small pane never + // shrinks the grid below a larger sibling. Reacting to every view's resize + // would also fire mid-layout, when a sibling's geometry is still stale, and + // let a transient size stick — so keep this gated on the active view. if (v == m_active_view) resizeToActive(); } -// Recompute PTY/vterm grid from the active view's pixel size and ITS cell -// metrics. No-op when there is no active view (buffer displayed nowhere) — -// the shell keeps its last size, like Emacs with a buried vterm buffer. +// Recompute the PTY/vterm grid from the view that should drive it. +// +// A terminal buffer has ONE libvterm screen but can be shown in several +// windows (views) at once. Size the grid to the LARGEST view by pixel area: +// the biggest window then renders the program's full output, while smaller +// windows showing the same buffer display a clipped top-left view of the same +// screen. This matches Emacs' behaviour when one buffer is split across +// windows of different sizes, and stops a small pane from shrinking the grid +// and truncating a large one — e.g. `top` collapsing to a few rows after a +// C-x 2 split, or a big window being truncated to a small sibling's size. +// +// No-op when there are no views (buffer displayed nowhere) — the shell keeps +// its last size, like Emacs with a buried vterm buffer. void QTerminalSession::resizeToActive() { - QTerminalView* v = m_active_view; + QTerminalView* v = nullptr; + long best_area = -1; + for (QTerminalView* view : m_views) { + if (!view) continue; + long area = static_cast<long>(view->width()) * + static_cast<long>(view->height()); + if (area > best_area) { best_area = area; v = view; } + } + if (!v) v = m_active_view; if (!v) return; int cw = v->m_cell_w > 0 ? v->m_cell_w : 8; int ch = v->m_cell_h > 0 ? v->m_cell_h : 16;