Revert to external jsh spawn for vterm; drop in-process jsh PTY bridge
ober
571a401def0d8d2892273d19e025a097c2ee6f3d
--- a/lib/jerboa-emacs/qt/commands-config.sls +++ b/lib/jerboa-emacs/qt/commands-config.sls @@ -19,8 +19,7 @@ *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 pty-prompt jsh-pty-drain-channel! - jsh-pty-loop! cmd-term jsh-pty-stop! cmd-terminal-send + 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 @@ -40,8 +39,7 @@ (jerboa-emacs editor) (jerboa-emacs repl) (jerboa-emacs eshell) (jerboa-emacs gsh-eshell) (jerboa-emacs shell) (jerboa-emacs shell-history) - (jerboa-emacs terminal) (jerboa-emacs pty) - (only (jsh environment) env-get env-set!) + (jerboa-emacs terminal) (only (jsh environment) env-get) (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) @@ -902,78 +900,9 @@ (sci-send ed SCI_SETSTYLING text-len style)) (loop (cdr segs) (+ pos text-len))))))) (define terminal-buffer-counter--cell (vector 0)) - (def (pty-prompt ts) - "Return the expanded PS1 prompt with ANSI colors intact but readline\n non-printing markers (\\001/\\002) stripped. Safe to write directly to a PTY." - (let ([raw (terminal-prompt-raw ts)]) - (let loop ([i 0] [acc '()]) - (if (>= i (string-length raw)) - (list->string (reverse acc)) - (let ([ch (string-ref raw i)]) - (if (or (char=? ch (integer->char 1)) - (char=? ch (integer->char 2))) - (loop (+ i 1) acc) - (loop (+ i 1) (cons ch acc)))))))) - (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 (pty-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 (pty-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 (pty-prompt ts)) - (loop)] - [(async) - (jsh-pty-drain-channel! slave-fd ts) - (pty-write slave-fd (pty-prompt ts)) - (loop)] - [(special) - (cond - [(eq? output 'clear) - (pty-write slave-fd "\x1B;[2J\x1B;[H")] - [else (void)]) - (pty-write slave-fd (pty-prompt ts)) - (loop)]))]))]))))) (def (cmd-term app) - "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)") + "Open a QTerminalWidget-backed terminal running jsh as the shell." + (verbose-log! "cmd-term: begin (QTerminalWidget + jsh)") (let* ([fr (app-state-frame app)] [ed (current-qt-editor app)] [name (begin @@ -994,55 +923,34 @@ (let ([msg (with-output-to-string (lambda () (display-exception e)))]) (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-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))))) + (let* ([win (qt-current-window fr)] + [container (qt-edit-window-container win)] + [term (qt-terminal-create container)] + [jsh-path (or (getenv "JSH") "/usr/local/bin/jsh")]) + (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-spawn! term jsh-path) + (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) + (verbose-log! "cmd-term: spawned jsh=" jsh-path) + (echo-message! + (app-state-echo app) + (string-append name " started"))))))) (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,31 +4,30 @@ (library (jerboa-emacs qt commands-shell) (export directory-exists? *terminal-widget-map* - *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! + *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! cmd-toggle-delete-trailing-whitespace-on-save uniquify-parent-suffix uniquify-buffer-name! cmd-recentf-open-files cmd-toggle-frame-fullscreen @@ -121,7 +120,6 @@ (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)] @@ -2291,10 +2289,6 @@ *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,7 +662,6 @@ (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) @@ -711,7 +710,6 @@ (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/commands-config.ss +++ b/src/jerboa-emacs/qt/commands-config.ss @@ -27,8 +27,7 @@ :jerboa-emacs/shell :jerboa-emacs/shell-history :jerboa-emacs/terminal - :jerboa-emacs/pty - (only-in :jsh/environment env-get env-set!) + (only-in :jsh/environment env-get) :jerboa-emacs/qt/buffer :jerboa-emacs/qt/window :jerboa-emacs/qt/echo @@ -755,95 +754,11 @@ modified so the next save uses the new encoding." (def terminal-buffer-counter 0) -;; *terminal-widget-map* and *jsh-pty-map* are defined in commands-shell -;; (which this module imports) - -(def (pty-prompt ts) - "Return the expanded PS1 prompt with ANSI colors intact but readline - non-printing markers (\\001/\\002) stripped. Safe to write directly to a PTY." - (let ((raw (terminal-prompt-raw ts))) - (let loop ((i 0) (acc '())) - (if (>= i (string-length raw)) - (list->string (reverse acc)) - (let ((ch (string-ref raw i))) - ;; Strip RL_PROMPT_START_IGNORE (\\001) and RL_PROMPT_END_IGNORE (\\002) - (if (or (char=? ch (integer->char 1)) - (char=? ch (integer->char 2))) - (loop (+ i 1) acc) - (loop (+ i 1) (cons ch acc)))))))) - -(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 (pty-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 (pty-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 (pty-prompt ts)) - (loop)) - ((async) - ;; Subprocess running: drain channel, writing output to slave fd - (jsh-pty-drain-channel! slave-fd ts) - (pty-write slave-fd (pty-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 (pty-prompt ts)) - (loop))))))))))))) +;; *terminal-widget-map* and *terminal-container-map* are defined in commands-shell (def (cmd-term app) - "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)") + "Open a QTerminalWidget-backed terminal running jsh as the shell." + (verbose-log! "cmd-term: begin (QTerminalWidget + jsh)") (let* ((fr (app-state-frame app)) (ed (current-qt-editor app)) (name (begin @@ -853,64 +768,31 @@ modified so the next save uses the new encoding." (string-append "*terminal-" (number->string terminal-buffer-counter) "*")))) (buf (qt-buffer-create! name ed #f))) - ;; Mark as terminal buffer (set! (buffer-lexer-lang buf) 'terminal) - ;; Attach buffer to editor (sets up document etc.) (qt-buffer-attach! ed buf) (set! (qt-edit-window-buffer (qt-current-window fr)) buf) (with-catch (lambda (e) (let ((msg (with-output-to-string (lambda () (display-exception e))))) (jemacs-log! "cmd-term: failed: " msg) - (verbose-log! "cmd-term: FAILED: " msg) (echo-error! (app-state-echo app) (string-append "Terminal failed: " msg)))) (lambda () - ;; 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))))) + (let* ((win (qt-current-window fr)) + (container (qt-edit-window-container win)) + (term (qt-terminal-create container)) + (jsh-path (or (getenv "JSH") "/usr/local/bin/jsh"))) + (qt-terminal-set-font! term *default-font-family* *default-font-size*) + (qt-terminal-set-colors! term #xbbc2cf #x282c34) + (qt-stacked-widget-add-widget! container (qt-terminal-widget term)) + (qt-stacked-widget-set-current-widget! container (qt-terminal-widget term)) + (qt-terminal-spawn! term jsh-path) + (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) + (verbose-log! "cmd-term: spawned jsh=" jsh-path) + (echo-message! (app-state-echo app) (string-append name " started"))))))) (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,12 +70,6 @@ ;; 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,8 +624,6 @@ (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 @@ -669,7 +667,6 @@ (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*