Replace external bash vterm with in-process jsh PTY bridge; fix blank terminal switching
ober
523c59532d246af8058aacf6e7ef70c85e4234cb
--- a/lib/jerboa-emacs/async.sls +++ b/lib/jerboa-emacs/async.sls @@ -552,8 +552,8 @@ (let ([v (hashtable-ref cache key - '#{miss omw6w8wawbthtimg5q8die4gm-1})]) - (if (eq? v '#{miss omw6w8wawbthtimg5q8die4gm-2}) + '#{miss i74zlg6svppkfsq0wemtyoahg-1})]) + (if (eq? v '#{miss i74zlg6svppkfsq0wemtyoahg-2}) (if (null? default) #f (car default)) v))) (def (weak-cache-set! cache key value) --- a/lib/jerboa-emacs/pty.sls +++ b/lib/jerboa-emacs/pty.sls @@ -6,6 +6,7 @@ (library (jerboa-emacs pty) (export pty-spawn + pty-openpty pty-read pty-last-errno pty-write @@ -65,11 +66,23 @@ (foreign-procedure "pty_get_wait_status" () int)) (define ffi-pty-last-errno (foreign-procedure "pty_last_errno" () int)) + (define ffi-pty-openpty + (foreign-procedure "pty_openpty" (int int) int)) + (define ffi-pty-get-open-slave-fd + (foreign-procedure "pty_get_open_slave_fd" () int)) ;;; ======================================================================== ;;; Scheme-level API ;;; ======================================================================== + (def (pty-openpty rows cols) + "Create a PTY pair without spawning a child process. + Returns (values master-fd slave-fd) on success, (values #f #f) on failure." + (let ((master-fd (ffi-pty-openpty rows cols))) + (if (>= master-fd 0) + (values master-fd (ffi-pty-get-open-slave-fd)) + (values #f #f)))) + (def (pty-spawn cmd env-alist rows cols) (let* ((env-str (env-alist->string env-alist)) (result (ffi-pty-spawn cmd env-str rows cols))) --- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -798,9 +798,9 @@ (hash-put! terminal-key-installed tw #t)) (if (> count 1) (begin - (qt-stacked-widget-set-current-index! + (qt-stacked-widget-set-current-widget! container - (- count 1)) + tw) (qt-widget-set-focus! tw)) (qt-widget-set-focus! editor))))))] [(image-buffer? buf) --- a/lib/jerboa-emacs/qt/commands-config.sls +++ b/lib/jerboa-emacs/qt/commands-config.sls @@ -19,12 +19,13 @@ *profiler-data* cmd-profiler-start cmd-profiler-stop cmd-show-tab-count cmd-show-trailing-whitespace-count *SCI_SETCODEPAGE* *SC_CP_UTF8* qt-insert-prompt! - terminal-buffer-counter cmd-term cmd-terminal-send - cmd-term-interrupt cmd-term-send-eof cmd-term-send-tab - cmd-multi-vterm *terminal-copy-mode* cmd-vterm-copy-mode - cmd-vterm-copy-done get-terminal-buffers - qt-switch-to-terminal! cmd-term-list cmd-term-next - cmd-term-prev cmd-ediff-files cmd-comment-dwim) + terminal-buffer-counter jsh-pty-drain-channel! jsh-pty-loop! + cmd-term jsh-pty-stop! cmd-terminal-send cmd-term-interrupt + cmd-term-send-eof cmd-term-send-tab cmd-multi-vterm + *terminal-copy-mode* cmd-vterm-copy-mode cmd-vterm-copy-done + get-terminal-buffers qt-switch-to-terminal! cmd-term-list + cmd-term-next cmd-term-prev cmd-ediff-files + cmd-comment-dwim) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -39,7 +40,8 @@ (jerboa-emacs editor) (jerboa-emacs repl) (jerboa-emacs eshell) (jerboa-emacs gsh-eshell) (jerboa-emacs shell) (jerboa-emacs shell-history) - (jerboa-emacs terminal) (only (jsh environment) env-get) + (jerboa-emacs terminal) (jerboa-emacs pty) + (only (jsh environment) env-get env-set!) (jerboa-emacs qt buffer) (jerboa-emacs qt window) (jerboa-emacs qt echo) (jerboa-emacs qt highlight) (jerboa-emacs qt modeline) (jerboa-emacs qt commands-core) @@ -900,9 +902,67 @@ (sci-send ed SCI_SETSTYLING text-len style)) (loop (cdr segs) (+ pos text-len))))))) (define terminal-buffer-counter--cell (vector 0)) + (def (jsh-pty-drain-channel! slave-fd ts) + "Block-poll the terminal's PTY channel until subprocess exits, writing output to slave-fd." + (let loop () + (let ([msg (terminal-poll-output ts)]) + (cond + [(not msg) (thread-sleep! 0.01) (loop)] + [(eq? (car msg) 'data) + (pty-write slave-fd (cdr msg)) + (loop)] + [else (terminal-cleanup-pty! ts)])))) + (def (jsh-pty-loop! slave-fd ts) + "Run in-process jsh loop connected to slave-fd.\n Reads lines from slave-fd (via PTY line discipline), executes via jsh,\n writes output back to slave-fd so QTerminalWidget can render it." + (let* ([in-port (open-fd-input-port + slave-fd + (buffer-mode block) + (native-transcoder))]) + (pty-write slave-fd (terminal-prompt ts)) + (let loop () + (let ([line (with-catch + (lambda (e) #f) + (lambda () (get-line in-port)))]) + (cond + [(or (not line) (eof-object? line)) (void)] + [else + (let ([trimmed (safe-string-trim-both line)]) + (cond + [(string=? trimmed "") + (pty-write slave-fd (terminal-prompt ts)) + (loop)] + [(string=? trimmed "exit") (pty-close! slave-fd #f)] + [else + (let-values ([(mode output new-cwd) + (terminal-execute-async! + trimmed + ts + 24 + 80)]) + (case mode + [(sync) + (when (and (string? output) + (> (string-length output) 0)) + (pty-write slave-fd output) + (unless (string-suffix? "\n" output) + (pty-write slave-fd "\n"))) + (pty-write slave-fd (terminal-prompt ts)) + (loop)] + [(async) + (jsh-pty-drain-channel! slave-fd ts) + (pty-write slave-fd (terminal-prompt ts)) + (loop)] + [(special) + (cond + [(eq? output 'clear) + (pty-write slave-fd "\x1B;[2J\x1B;[H")] + [else (void)]) + (pty-write slave-fd (terminal-prompt ts)) + (loop)]))]))]))))) (def (cmd-term app) - "Open a QTerminalWidget-backed terminal buffer.\n Uses libvterm for proper VT100 terminal emulation with full color support." - (verbose-log! "cmd-term: begin (QTerminalWidget)") + "Open a QTerminalWidget-backed terminal with in-process jsh.\n Creates a PTY pair: jsh runs in a Chez thread on the slave side,\n QTerminalWidget reads from the master side for VT100 rendering." + (verbose-log! + "cmd-term: begin (QTerminalWidget + in-process jsh)") (let* ([fr (app-state-frame app)] [ed (current-qt-editor app)] [name (begin @@ -922,33 +982,56 @@ (lambda (e) (let ([msg (with-output-to-string (lambda () (display-exception e)))]) - (jemacs-log! "cmd-term: QTerminalWidget failed: " msg) - (verbose-log! "cmd-term: QTerminalWidget FAILED: " msg) + (jemacs-log! "cmd-term: failed: " msg) + (verbose-log! "cmd-term: FAILED: " msg) (echo-error! (app-state-echo app) (string-append "Terminal failed: " msg)))) (lambda () - (let* ([win (qt-current-window fr)] - [container (qt-edit-window-container win)] - [term (qt-terminal-create container)]) - (qt-terminal-set-font! - term - *default-font-family* - *default-font-size*) - (qt-terminal-set-colors! term 12305103 2632756) - (let ([idx (qt-stacked-widget-add-widget! - container - (qt-terminal-widget term))]) - (qt-stacked-widget-set-current-index! container idx)) - (hash-put! *terminal-widget-map* buf term) - (hash-put! *terminal-container-map* buf container) - ((app-state-key-handler app) (qt-terminal-widget term)) - (qt-terminal-spawn! term "") - (qt-terminal-focus! term) - (verbose-log! "cmd-term: QTerminalWidget spawned") - (echo-message! - (app-state-echo app) - (string-append name " started"))))))) + (let-values ([(master-fd slave-fd) (pty-openpty 24 80)]) + (unless master-fd (error 'cmd-term "pty-openpty failed")) + (let* ([win (qt-current-window fr)] + [container (qt-edit-window-container win)] + [term (qt-terminal-create container)]) + (qt-terminal-set-font! + term + *default-font-family* + *default-font-size*) + (qt-terminal-set-colors! term 12305103 2632756) + (qt-stacked-widget-add-widget! + container + (qt-terminal-widget term)) + (qt-stacked-widget-set-current-widget! + container + (qt-terminal-widget term)) + (qt-terminal-connect-fd! term master-fd) + (hash-put! *terminal-widget-map* buf term) + (hash-put! *terminal-container-map* buf container) + ((app-state-key-handler app) (qt-terminal-widget term)) + (qt-terminal-focus! term) + (let ([ts (terminal-start!)]) + (env-set! + (terminal-state-env ts) + "TERM" + "xterm-256color") + (hash-put! *jsh-pty-map* buf (cons ts slave-fd)) + (spawn (lambda () (jsh-pty-loop! slave-fd ts))) + (verbose-log! + "cmd-term: jsh-pty started on slave-fd=" + (number->string slave-fd)) + (echo-message! + (app-state-echo app) + (string-append name " started"))))))))) + (def (jsh-pty-stop! buf) + "Stop a jsh-pty terminal: close slave fd (jsh thread exits), clean up map." + (let ([entry (hash-get *jsh-pty-map* buf)]) + (when entry + (let ([ts (car entry)] [slave-fd (cdr entry)]) + (with-catch + (lambda (e) (void)) + (lambda () (pty-close! slave-fd #f))) + (terminal-stop! ts) + (hash-remove! *jsh-pty-map* buf))))) (def (cmd-terminal-send app) "Execute the current input line in the terminal via gsh.\n Builtins run synchronously, external commands run async via PTY.\n When PTY is busy (e.g. sudo password prompt), sends newline to PTY." (let* ([buf (current-qt-buffer app)] --- a/lib/jerboa-emacs/qt/commands-shell.sls +++ b/lib/jerboa-emacs/qt/commands-shell.sls @@ -4,30 +4,31 @@ (library (jerboa-emacs qt commands-shell) (export directory-exists? *terminal-widget-map* - *terminal-container-map* apply-font-size-to-all-editors! - cmd-increase-font-size cmd-decrease-font-size - cmd-reset-font-size cmd-goto-first-non-blank - cmd-goto-last-non-blank cmd-move-to-window-top - cmd-move-to-window-middle cmd-move-to-window-bottom - cmd-scroll-left cmd-scroll-right cmd-insert-let - cmd-insert-lambda cmd-insert-defun cmd-insert-cond - cmd-insert-when cmd-insert-unless cmd-insert-match - cmd-insert-import cmd-insert-export cmd-insert-include - cmd-insert-file-header cmd-insert-header-guard - cmd-insert-box-comment cmd-insert-file-contents - cmd-insert-register-string *auto-indent* *backup-files* - *version-control* *debug-mode* *debug-on-quit* - *visible-bell* *transient-mark* *electric-indent* - cmd-toggle-auto-indent cmd-toggle-backup-files - cmd-toggle-version-control cmd-toggle-debug-mode - cmd-toggle-debug-on-quit cmd-toggle-visible-bell - cmd-toggle-transient-mark cmd-toggle-electric-indent - cmd-toggle-auto-revert cmd-toggle-auto-revert-global - cmd-auto-revert-tail-mode *view-mode-buffers* cmd-view-mode - *so-long-threshold* *so-long-buffers* check-so-long! - cmd-so-long-mode *follow-mode* cmd-follow-mode - *command-history-file* savehist-save! savehist-load! - auto-fill-check! qt-aggressive-indent-line! + *terminal-container-map* *jsh-pty-map* + apply-font-size-to-all-editors! cmd-increase-font-size + cmd-decrease-font-size cmd-reset-font-size + cmd-goto-first-non-blank cmd-goto-last-non-blank + cmd-move-to-window-top cmd-move-to-window-middle + cmd-move-to-window-bottom cmd-scroll-left cmd-scroll-right + cmd-insert-let cmd-insert-lambda cmd-insert-defun + cmd-insert-cond cmd-insert-when cmd-insert-unless + cmd-insert-match cmd-insert-import cmd-insert-export + cmd-insert-include cmd-insert-file-header + cmd-insert-header-guard cmd-insert-box-comment + cmd-insert-file-contents cmd-insert-register-string + *auto-indent* *backup-files* *version-control* *debug-mode* + *debug-on-quit* *visible-bell* *transient-mark* + *electric-indent* cmd-toggle-auto-indent + cmd-toggle-backup-files cmd-toggle-version-control + cmd-toggle-debug-mode cmd-toggle-debug-on-quit + cmd-toggle-visible-bell cmd-toggle-transient-mark + cmd-toggle-electric-indent cmd-toggle-auto-revert + cmd-toggle-auto-revert-global cmd-auto-revert-tail-mode + *view-mode-buffers* cmd-view-mode *so-long-threshold* + *so-long-buffers* check-so-long! cmd-so-long-mode + *follow-mode* cmd-follow-mode *command-history-file* + savehist-save! savehist-load! auto-fill-check! + qt-aggressive-indent-line! cmd-toggle-delete-trailing-whitespace-on-save uniquify-parent-suffix uniquify-buffer-name! cmd-recentf-open-files cmd-toggle-frame-fullscreen @@ -120,6 +121,7 @@ (vector (make-hash-table-eq))) (define *terminal-container-map*--cell (vector (make-hash-table-eq))) + (define *jsh-pty-map*--cell (vector (make-hash-table-eq))) (def (apply-font-size-to-all-editors! app) "Apply the current global font size to all open editors." (let ([fr (app-state-frame app)] @@ -2289,6 +2291,10 @@ *terminal-container-map*--cell 0 val)])) + (define-syntax *jsh-pty-map* + (identifier-syntax + [id (vector-ref *jsh-pty-map*--cell 0)] + [(set! id val) (vector-set! *jsh-pty-map*--cell 0 val)])) (define-syntax *auto-indent* (identifier-syntax [id (vector-ref *auto-indent*--cell 0)] --- a/lib/jerboa-emacs/qt/commands.sls +++ b/lib/jerboa-emacs/qt/commands.sls @@ -662,6 +662,7 @@ (when ts (terminal-stop! ts) (hash-remove! *terminal-state* buf))) + (jsh-pty-stop! buf) (let ([cs (hash-get *chat-state* buf)]) (when cs (chat-stop! cs) @@ -710,6 +711,7 @@ (when ts (terminal-stop! ts) (hash-remove! *terminal-state* buf))) + (jsh-pty-stop! buf) (let ([cs (hash-get *chat-state* buf)]) (when cs (chat-stop! cs) (hash-remove! *chat-state* buf))) (set! *buffer-recent* --- a/lib/jerboa-emacs/qt/sci-shim.sls +++ b/lib/jerboa-emacs/qt/sci-shim.sls @@ -110,7 +110,8 @@ qt-splitter-set-orientation! qt-splitter-set-sizes! qt-splitter-size-at qt-stacked-widget-add-widget! qt-stacked-widget-count qt-stacked-widget-create - qt-stacked-widget-set-current-index! qt-timer-create + qt-stacked-widget-set-current-index! + qt-stacked-widget-set-current-widget! qt-timer-create qt-timer-set-single-shot! qt-timer-start! qt-timer-stop! qt-toolbar-add-action! qt-toolbar-add-separator! qt-toolbar-create qt-toolbar-set-movable! qt-widget-close! @@ -137,10 +138,11 @@ QT_CURSOR_NEXT_CHAR QT_CURSOR_NEXT_WORD QT_CURSOR_PREVIOUS_CHAR QT_CURSOR_PREVIOUS_WORD qt-terminal-create qt-terminal-destroy! qt-terminal-spawn! - qt-terminal-send-key-event! qt-terminal-send-input! - qt-terminal-is-running? qt-terminal-interrupt! - qt-terminal-set-font! qt-terminal-set-colors! - qt-terminal-focus! qt-terminal-widget) + qt-terminal-connect-fd! qt-terminal-send-key-event! + qt-terminal-send-input! qt-terminal-is-running? + qt-terminal-interrupt! qt-terminal-set-font! + qt-terminal-set-colors! qt-terminal-focus! + qt-terminal-widget) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -580,6 +582,13 @@ ((foreign-procedure "qt_terminal_spawn" (void* string) void) term cmd)) + (def (qt-terminal-connect-fd! term master-fd) + "Connect QTerminalWidget to an already-open PTY master fd.\n No fork or exec — for in-process jsh integration." + ((foreign-procedure "qt_terminal_connect_fd" + (void* int) + void) + term + master-fd)) (def (qt-terminal-send-key-event! term key mods text) "Send a synthetic key event to the terminal widget.\n KEY is the Qt key code, MODS the Qt modifier flags, TEXT the key text." ((foreign-procedure "qt_terminal_send_key_event" --- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -847,7 +847,7 @@ (if (> count 1) ;; Terminal widget lives in THIS container — show and focus it (begin - (qt-stacked-widget-set-current-index! container (- count 1)) + (qt-stacked-widget-set-current-widget! container tw) (qt-widget-set-focus! tw)) ;; Terminal widget is in another window (e.g. after C-x 2). ;; Just show the editor in this window — don't steal focus. --- a/src/jerboa-emacs/qt/commands-config.ss +++ b/src/jerboa-emacs/qt/commands-config.ss @@ -27,7 +27,8 @@ :jerboa-emacs/shell :jerboa-emacs/shell-history :jerboa-emacs/terminal - (only-in :jsh/environment env-get) + :jerboa-emacs/pty + (only-in :jsh/environment env-get env-set!) :jerboa-emacs/qt/buffer :jerboa-emacs/qt/window :jerboa-emacs/qt/echo @@ -754,12 +755,81 @@ modified so the next save uses the new encoding." (def terminal-buffer-counter 0) -;; *terminal-widget-map* is defined in commands-shell (which this module imports) +;; *terminal-widget-map* and *jsh-pty-map* are defined in commands-shell +;; (which this module imports) + +(def (jsh-pty-drain-channel! slave-fd ts) + "Block-poll the terminal's PTY channel until subprocess exits, writing output to slave-fd." + (let loop () + (let ((msg (terminal-poll-output ts))) + (cond + ((not msg) + ;; No message yet — sleep 10ms and keep polling + (thread-sleep! 0.010) + (loop)) + ((eq? (car msg) 'data) + (pty-write slave-fd (cdr msg)) + (loop)) + ;; 'done — subprocess exited; clean up PTY state + (else + (terminal-cleanup-pty! ts)))))) + +(def (jsh-pty-loop! slave-fd ts) + "Run in-process jsh loop connected to slave-fd. + Reads lines from slave-fd (via PTY line discipline), executes via jsh, + writes output back to slave-fd so QTerminalWidget can render it." + (let* ((in-port (open-fd-input-port slave-fd (buffer-mode block) (native-transcoder)))) + ;; Write initial prompt to slave (appears in QTerminalWidget via master fd) + (pty-write slave-fd (terminal-prompt ts)) + (let loop () + (let ((line (with-catch (lambda (e) #f) + (lambda () (get-line in-port))))) + (cond + ((or (not line) (eof-object? line)) + ;; EOF or error: slave closed, exit loop + (void)) + (else + (let ((trimmed (safe-string-trim-both line))) + (cond + ((string=? trimmed "") + ;; Empty line: re-prompt + (pty-write slave-fd (terminal-prompt ts)) + (loop)) + ((string=? trimmed "exit") + ;; Exit: close slave fd (causes QTerminalWidget master to see EOF) + (pty-close! slave-fd #f)) + (else + ;; Execute command via jsh + (let-values (((mode output new-cwd) + (terminal-execute-async! trimmed ts 24 80))) + (case mode + ((sync) + (when (and (string? output) (> (string-length output) 0)) + (pty-write slave-fd output) + (unless (string-suffix? "\n" output) + (pty-write slave-fd "\n"))) + (pty-write slave-fd (terminal-prompt ts)) + (loop)) + ((async) + ;; Subprocess running: drain channel, writing output to slave fd + (jsh-pty-drain-channel! slave-fd ts) + (pty-write slave-fd (terminal-prompt ts)) + (loop)) + ((special) + (cond + ((eq? output 'clear) + ;; Send VT100 clear sequence (ESC[2J ESC[H) + (pty-write slave-fd "\x1b;[2J\x1b;[H")) + ;; Other specials: ignore for now + (else (void))) + (pty-write slave-fd (terminal-prompt ts)) + (loop))))))))))))) (def (cmd-term app) - "Open a QTerminalWidget-backed terminal buffer. - Uses libvterm for proper VT100 terminal emulation with full color support." - (verbose-log! "cmd-term: begin (QTerminalWidget)") + "Open a QTerminalWidget-backed terminal with in-process jsh. + Creates a PTY pair: jsh runs in a Chez thread on the slave side, + QTerminalWidget reads from the master side for VT100 rendering." + (verbose-log! "cmd-term: begin (QTerminalWidget + in-process jsh)") (let* ((fr (app-state-frame app)) (ed (current-qt-editor app)) (name (begin @@ -774,41 +844,59 @@ modified so the next save uses the new encoding." ;; Attach buffer to editor (sets up document etc.) (qt-buffer-attach! ed buf) (set! (qt-edit-window-buffer (qt-current-window fr)) buf) - ;; Create QTerminalWidget inside the QStackedWidget container (with-catch (lambda (e) (let ((msg (with-output-to-string (lambda () (display-exception e))))) - (jemacs-log! "cmd-term: QTerminalWidget failed: " msg) - (verbose-log! "cmd-term: QTerminalWidget FAILED: " msg) + (jemacs-log! "cmd-term: failed: " msg) + (verbose-log! "cmd-term: FAILED: " msg) (echo-error! (app-state-echo app) (string-append "Terminal failed: " msg)))) (lambda () - (let* ((win (qt-current-window fr)) - (container (qt-edit-window-container win)) - (term (qt-terminal-create container))) - ;; Set monospace font - (qt-terminal-set-font! term *default-font-family* *default-font-size*) - ;; Set colors: light gray on dark background - (qt-terminal-set-colors! term #xbbc2cf #x282c34) - ;; Add terminal widget to QStackedWidget and switch to it - (let ((idx (qt-stacked-widget-add-widget! container (qt-terminal-widget term)))) - (qt-stacked-widget-set-current-index! container idx)) - ;; Store widget mapping for key forwarding and buffer switching - (hash-put! *terminal-widget-map* buf term) - ;; Track which container this terminal lives in so the pre-destroy - ;; hook can detach it before the container is freed - (hash-put! *terminal-container-map* buf container) - ;; Install consuming key filter so all keys go through Scheme first - ;; (same pattern as image scroll widgets — without this, Qt sends keys - ;; directly to QTerminalWidget::keyPressEvent, bypassing jemacs entirely) - ((app-state-key-handler app) (qt-terminal-widget term)) - ;; Spawn the user's shell - (qt-terminal-spawn! term "") - ;; Focus the terminal widget - (qt-terminal-focus! term) - (verbose-log! "cmd-term: QTerminalWidget spawned") - (echo-message! (app-state-echo app) - (string-append name " started"))))))) + ;; Create PTY pair without forking: master → QTerminalWidget, slave → jsh + (let-values (((master-fd slave-fd) (pty-openpty 24 80))) + (unless master-fd + (error 'cmd-term "pty-openpty failed")) + (let* ((win (qt-current-window fr)) + (container (qt-edit-window-container win)) + (term (qt-terminal-create container))) + ;; Configure font and colors + (qt-terminal-set-font! term *default-font-family* *default-font-size*) + (qt-terminal-set-colors! term #xbbc2cf #x282c34) + ;; Add terminal widget to QStackedWidget and switch to it + (qt-stacked-widget-add-widget! container (qt-terminal-widget term)) + (qt-stacked-widget-set-current-widget! container (qt-terminal-widget term)) + ;; Connect QTerminalWidget to our PTY master fd (no fork/exec) + (qt-terminal-connect-fd! term master-fd) + ;; Store mappings for key forwarding, buffer switching, and cleanup + (hash-put! *terminal-widget-map* buf term) + (hash-put! *terminal-container-map* buf container) + ;; Install consuming key filter (same as before) + ((app-state-key-handler app) (qt-terminal-widget term)) + ;; Focus the terminal widget + (qt-terminal-focus! term) + ;; Initialize in-process jsh environment + (let ((ts (terminal-start!))) + ;; Set TERM so jsh and subprocesses know terminal capabilities + (env-set! (terminal-state-env ts) "TERM" "xterm-256color") + ;; Store in jsh-pty-map for cleanup (not *terminal-state* so + ;; the old Scintilla poll timer ignores this buffer) + (hash-put! *jsh-pty-map* buf (cons ts slave-fd)) + ;; Start jsh in a background thread reading from slave fd + (spawn (lambda () (jsh-pty-loop! slave-fd ts))) + (verbose-log! "cmd-term: jsh-pty started on slave-fd=" (number->string slave-fd)) + (echo-message! (app-state-echo app) (string-append name " started"))))))))) + +;; Close slave fd for a jsh-pty terminal (causes jsh thread to exit via EOF) +(def (jsh-pty-stop! buf) + "Stop a jsh-pty terminal: close slave fd (jsh thread exits), clean up map." + (let ((entry (hash-get *jsh-pty-map* buf))) + (when entry + (let ((ts (car entry)) + (slave-fd (cdr entry))) + (with-catch (lambda (e) (void)) + (lambda () (pty-close! slave-fd #f))) + (terminal-stop! ts) + (hash-remove! *jsh-pty-map* buf))))) (def (cmd-terminal-send app) "Execute the current input line in the terminal via gsh. --- a/src/jerboa-emacs/qt/commands-shell.ss +++ b/src/jerboa-emacs/qt/commands-shell.ss @@ -70,6 +70,12 @@ ;; that is about to be destroyed, so it can detach/destroy the terminal first. (def *terminal-container-map* (make-hash-table-eq)) +;; Map buffer → (terminal-state . slave-fd) for in-process jsh terminals. +;; Used by the jsh-pty integration: jsh runs in a Chez thread connected to +;; the slave fd, QTerminalWidget reads from the master fd for VT100 rendering. +;; Distinct from *terminal-state* so the old Scintilla poll timer ignores these. +(def *jsh-pty-map* (make-hash-table-eq)) + ;; --- Font size --- ;; Note: Font size state is now in face.ss (*default-font-size*) --- a/src/jerboa-emacs/qt/commands.ss +++ b/src/jerboa-emacs/qt/commands.ss @@ -624,6 +624,8 @@ (when ts (terminal-stop! ts) (hash-remove! *terminal-state* buf))) + ;; Clean up jsh-pty terminal if applicable + (jsh-pty-stop! buf) ;; Clean up chat state if applicable (let ((cs (hash-get *chat-state* buf))) (when cs @@ -667,6 +669,7 @@ (when ss (shell-stop! ss) (hash-remove! *shell-state* buf))) (let ((ts (hash-get *terminal-state* buf))) (when ts (terminal-stop! ts) (hash-remove! *terminal-state* buf))) + (jsh-pty-stop! buf) (let ((cs (hash-get *chat-state* buf))) (when cs (chat-stop! cs) (hash-remove! *chat-state* buf))) (set! *buffer-recent* --- a/src/jerboa-emacs/qt/sci-shim.ss +++ b/src/jerboa-emacs/qt/sci-shim.ss @@ -110,6 +110,7 @@ qt-splitter-set-sizes! qt-splitter-size-at ;; Stacked widget qt-stacked-widget-add-widget! qt-stacked-widget-count qt-stacked-widget-create qt-stacked-widget-set-current-index! + qt-stacked-widget-set-current-widget! ;; Timer qt-timer-create qt-timer-set-single-shot! qt-timer-start! qt-timer-stop! ;; Toolbar @@ -138,6 +139,7 @@ QT_CURSOR_PREVIOUS_CHAR QT_CURSOR_PREVIOUS_WORD ;; QTerminalWidget (libvterm-based terminal emulator) qt-terminal-create qt-terminal-destroy! qt-terminal-spawn! + qt-terminal-connect-fd! qt-terminal-send-key-event! qt-terminal-send-input! qt-terminal-is-running? qt-terminal-interrupt! qt-terminal-set-font! qt-terminal-set-colors! @@ -579,6 +581,11 @@ CMD is a command string; empty string means default $SHELL." ((foreign-procedure "qt_terminal_spawn" (void* string) void) term cmd)) +(def (qt-terminal-connect-fd! term master-fd) + "Connect QTerminalWidget to an already-open PTY master fd. + No fork or exec — for in-process jsh integration." + ((foreign-procedure "qt_terminal_connect_fd" (void* int) void) term master-fd)) + (def (qt-terminal-send-key-event! term key mods text) "Send a synthetic key event to the terminal widget. KEY is the Qt key code, MODS the Qt modifier flags, TEXT the key text." --- a/support/pty_shim.c +++ b/support/pty_shim.c @@ -165,3 +165,38 @@ int pty_get_wait_status(void) { return 128 + WTERMSIG(g_wait_status); return -1; } + +/* Per-call state for openpty (no fork) */ +static int g_open_master_fd = -1; +static int g_open_slave_fd = -1; + +/* + * Open a PTY pair without spawning a child process. + * Returns the master fd on success, -errno on failure. + * Caller retrieves slave fd via pty_get_open_slave_fd(). + * The master fd is made non-blocking for polling. + */ +int pty_openpty(int rows, int cols) { + struct winsize ws; + memset(&ws, 0, sizeof(ws)); + ws.ws_row = rows; + ws.ws_col = cols; + + g_open_master_fd = -1; + g_open_slave_fd = -1; + + int master_fd = -1, slave_fd = -1; + if (openpty(&master_fd, &slave_fd, NULL, NULL, &ws) < 0) + return -errno; + + /* Non-blocking reads on master side */ + int flags = fcntl(master_fd, F_GETFL, 0); + if (flags >= 0) + fcntl(master_fd, F_SETFL, flags | O_NONBLOCK); + + g_open_master_fd = master_fd; + g_open_slave_fd = slave_fd; + return master_fd; +} + +int pty_get_open_slave_fd(void) { return g_open_slave_fd; } Binary files a/support/pty_shim.so and b/support/pty_shim.so differ --- a/vendor/chez-qt/chez-qt/ffi.ss +++ b/vendor/chez-qt/chez-qt/ffi.ss @@ -419,6 +419,7 @@ ffi-qt-stacked-widget-create ffi-qt-stacked-widget-add-widget ffi-qt-stacked-widget-set-current-index ffi-qt-stacked-widget-current-index ffi-qt-stacked-widget-count ffi-qt-stacked-widget-on-current-changed + ffi-qt-stacked-widget-set-current-widget ;; Dock Widget ffi-qt-dock-widget-create ffi-qt-dock-widget-set-widget @@ -1829,6 +1830,8 @@ (foreign-procedure "qt_stacked_widget_count" (void*) int)) (define ffi-qt-stacked-widget-on-current-changed (foreign-procedure "chez_qt_stacked_widget_on_current_changed" (void* long) void)) + (define ffi-qt-stacked-widget-set-current-widget + (foreign-procedure "qt_stacked_widget_set_current_widget" (void* void*) void)) ;; ----------------------------------------------------------------------- ;; Dock Widget --- a/vendor/chez-qt/chez-qt/qt.ss +++ b/vendor/chez-qt/chez-qt/qt.ss @@ -261,6 +261,7 @@ qt-stacked-widget-create qt-stacked-widget-add-widget! qt-stacked-widget-set-current-index! qt-stacked-widget-current-index qt-stacked-widget-count qt-on-stacked-current-changed! + qt-stacked-widget-set-current-widget! ;; Dock Widget qt-dock-widget-create qt-dock-widget-set-widget! qt-dock-widget-widget @@ -1730,6 +1731,7 @@ (define (qt-stacked-widget-set-current-index! sw idx) (ffi-qt-stacked-widget-set-current-index sw idx)) (define (qt-stacked-widget-current-index sw) (ffi-qt-stacked-widget-current-index sw)) (define (qt-stacked-widget-count sw) (ffi-qt-stacked-widget-count sw)) + (define (qt-stacked-widget-set-current-widget! sw widget) (ffi-qt-stacked-widget-set-current-widget sw widget)) (define (qt-on-stacked-current-changed! sw handler) (let ([id (register-int-handler! handler)]) --- a/vendor/qt_shim.cpp +++ b/vendor/qt_shim.cpp @@ -2907,6 +2907,14 @@ extern "C" int qt_stacked_widget_count(qt_stacked_widget_t sw) { QT_RETURN(int, static_cast<QStackedWidget*>(sw)->count()); } +extern "C" void qt_stacked_widget_set_current_widget(qt_stacked_widget_t sw, + qt_widget_t widget) { + QT_NULL_CHECK_VOID(sw); + QT_NULL_CHECK_VOID(widget); + QT_VOID(static_cast<QStackedWidget*>(sw)->setCurrentWidget( + static_cast<QWidget*>(widget))); +} + extern "C" void qt_stacked_widget_on_current_changed(qt_stacked_widget_t sw, qt_callback_int callback, long callback_id) { @@ -7523,6 +7531,18 @@ public: // the widget is actually deleted (via deleteLater). void cleanupPtyPublic() { cleanupPty(); } + // Connect to an already-open PTY master fd (no fork, no exec). + // Used by the in-process jsh integration: Scheme creates the PTY pair, + // runs jsh in a thread on the slave side, and calls this to wire + // QTerminalWidget to the master side for VT100 rendering. + void connectMasterFd(int master_fd) { + if (m_running) return; + m_master_fd = master_fd; + m_child_pid = -1; // no child process to wait on + m_running = true; + m_timer->start(10); + } + // ── libvterm initialization ──────────────────────────────────────────── void initVterm() { @@ -7968,6 +7988,15 @@ extern "C" void qt_terminal_spawn(qt_terminal_t term, const char* cmd) { ); } +// Connect QTerminalWidget to an already-open PTY master fd. +// No fork or exec — used for in-process jsh integration. +extern "C" void qt_terminal_connect_fd(qt_terminal_t term, int master_fd) { + QT_NULL_CHECK_VOID(term); + QT_VOID( + static_cast<QTerminalWidget*>(term)->connectMasterFd(master_fd) + ); +} + extern "C" void qt_terminal_send_input(qt_terminal_t term, const char* data, int len) { QT_NULL_CHECK_VOID(term); // Copy data before crossing thread boundary