Apply themes to Qt terminals
ober
6b26fb3604f68dd66d3a2e29d76e286bfecf8f67
--- a/Makefile +++ b/Makefile @@ -79,7 +79,8 @@ JERBOA_SSL_ROOT ?= $(VENDOR)/jerboa-ssl CSSL ?= $(JERBOA_SSL_ROOT)/src JERBOA_HTTPS_ROOT ?= $(VENDOR)/jerboa-https CHTTPS ?= $(JERBOA_HTTPS_ROOT)/src -CQT ?= $(VENDOR)/jerboa-qt +CQT_ROOT ?= $(VENDOR)/jerboa-qt +CQT ?= $(CQT_ROOT)/lib JERBOA_PCRE2_ROOT ?= $(VENDOR)/jerboa-pcre2 JERBOA_PCRE2_LIBDIR ?= $(JERBOA_PCRE2_ROOT)/lib JERBOA_SCINTILLA_ROOT ?= $(VENDOR)/jerboa-scintilla @@ -98,7 +99,7 @@ ifeq ($(UNAME_S),Darwin) # -undefined dynamic_lookup: allow symbols resolved at load time from the host process SHLIB_FLAGS := -dynamiclib -Wl,-undefined,dynamic_lookup PRELOAD_VAR := DYLD_INSERT_LIBRARIES - export DYLD_LIBRARY_PATH := .:$(JERBOA_PCRE2_ROOT):$(JERBOA_SCINTILLA_ROOT):$(CQT):$(JSH_ROOT):$(DYLD_LIBRARY_PATH) + export DYLD_LIBRARY_PATH := .:$(JERBOA_PCRE2_ROOT):$(JERBOA_SCINTILLA_ROOT):$(CQT_ROOT):$(CQT):$(JSH_ROOT):$(DYLD_LIBRARY_PATH) PTY_LINK := XVFB_RUN := export QT_QPA_PLATFORM := cocoa @@ -110,7 +111,7 @@ else SHLIB_EXT := so SHLIB_FLAGS := -shared -fPIC PRELOAD_VAR := LD_PRELOAD - export LD_LIBRARY_PATH := .:$(JERBOA_PCRE2_ROOT):$(JERBOA_SCINTILLA_ROOT):$(CQT):$(JSH_ROOT):$(LD_LIBRARY_PATH) + export LD_LIBRARY_PATH := .:$(JERBOA_PCRE2_ROOT):$(JERBOA_SCINTILLA_ROOT):$(CQT_ROOT):$(CQT):$(JSH_ROOT):$(LD_LIBRARY_PATH) PTY_LINK := -lutil XVFB_RUN := xvfb-run -a QT_INC_FALLBACK := /usr/include/x86_64-linux-gnu/qt6 @@ -510,16 +511,19 @@ run-qt: build repl_shim.$(SHLIB_EXT) libqt_shim.$(SHLIB_EXT) vterm_shim.$(SHLIB_ # virtual display on Linux (static binary needs xcb). Auto-assigned REPL port. run-qt-test: build repl_shim.$(SHLIB_EXT) libqt_shim.$(SHLIB_EXT) vterm_shim.$(SHLIB_EXT) jerboa_qt_shim.$(SHLIB_EXT) @rm -f $(HOME)/.jerboa-repl-port - $(XVFB_RUN) $(PRELOAD_ENV) \ - $(SCHEME) $(LIBDIRS) --script qt-main.ss --repl 0 & - @for i in $$(seq 1 20); do \ + @LOG="$${TMPDIR:-/tmp}/jemacs-qt-test.log"; \ + rm -f "$$LOG"; \ + nohup $(XVFB_RUN) env $(PRELOAD_ENV) \ + $(SCHEME) $(LIBDIRS) --script qt-main.ss --repl 0 >"$$LOG" 2>&1 & + @for i in $$(seq 1 120); do \ [ -f $(HOME)/.jerboa-repl-port ] && break; \ sleep 0.3; \ done @if [ -f $(HOME)/.jerboa-repl-port ]; then \ echo "jemacs-qt running (headless). REPL port: $$(grep -oE '[0-9]+' $(HOME)/.jerboa-repl-port | head -1)"; \ + echo "Log: $${TMPDIR:-/tmp}/jemacs-qt-test.log"; \ else \ - echo "ERROR: REPL port file not created after 6s"; exit 1; \ + echo "ERROR: REPL port file not created after 36s"; exit 1; \ fi stop-qt-test: @@ -804,7 +808,7 @@ JSH_SRC ?= $(JSH_ROOT) JSH_VENDOR_SRC ?= $(JSH_SRC)/vendor PCRE2_SRC ?= $(JERBOA_PCRE2_ROOT) SCI_SRC ?= $(JERBOA_SCINTILLA_ROOT) -QT_SRC ?= $(CQT) +QT_SRC ?= $(CQT_ROOT) JAWS_SRC ?= $(JAWS) CSSL_SRC ?= $(JERBOA_SSL_ROOT) CHTTPS_SRC ?= $(JERBOA_HTTPS_ROOT) --- a/build-binary-qt.ss +++ b/build-binary-qt.ss @@ -114,7 +114,7 @@ (repo-path "vendor/jerboa-scintilla/src"))) (define qt-dir (or (getenv "JERBOA_QT_DIR") - (repo-path "vendor/jerboa-qt"))) + (repo-path "vendor/jerboa-qt/lib"))) (define qt-shim-dir (or (getenv "JERBOA_QT_SHIM_DIR") (repo-path "support/vendor-overrides"))) --- a/lib/jerboa-emacs/qt/commands-config.sls +++ b/lib/jerboa-emacs/qt/commands-config.sls @@ -933,7 +933,7 @@ session *default-font-family* *default-font-size*) - (qt-terminal-set-colors! session 12305103 2632756) + (apply-terminal-theme-to-session! session) (hash-put! *terminal-widget-map* buf session) (let ([view (terminal-ensure-view! app --- a/lib/jerboa-emacs/qt/commands-core.sls +++ b/lib/jerboa-emacs/qt/commands-core.sls @@ -10,6 +10,8 @@ cmd-winner-redo current-qt-editor current-qt-buffer *qt-app-ptr* *tab-bar-visible* qt-kill-ring-push! qt-clipboard-or-kill-ring *current-theme* theme-color + theme-hex-color->rgb-int current-terminal-theme-colors + *terminal-theme-apply-hook* set-terminal-theme-apply-hook! load-theme! load-theme define-theme! theme-stylesheet apply-theme! *buffer-recent* buffer-touch! buffer-names-mru *global-auto-revert-mode* *file-mtimes* @@ -206,6 +208,20 @@ (let ([theme (theme-get *current-theme*)]) (and theme (let ([pair (assoc key theme)]) (and pair (cdr pair)))))) + (def (theme-hex-color->rgb-int color-str fallback) + "Convert #RRGGBB theme color strings to 0xRRGGBB integers." + (let-values ([(r g b) + (parse-hex-color (or color-str fallback))]) + (+ (* r 65536) (* g 256) b))) + (def (current-terminal-theme-colors) + "Return default terminal foreground/background as 0xRRGGBB values." + (values + (theme-hex-color->rgb-int (theme-color 'fg) "#d8d8d8") + (theme-hex-color->rgb-int (theme-color 'bg) "#181818"))) + (define *terminal-theme-apply-hook*--cell (vector #f)) + (def (set-terminal-theme-apply-hook! proc) + "Install a callback run after theme changes to update native terminal sessions." + (set! *terminal-theme-apply-hook* proc)) (def (load-theme! theme-name) "Load a theme by applying its face definitions to the global *faces* registry." (let ([theme (theme-get theme-name)]) @@ -285,7 +301,9 @@ (qt-frame-windows fr)))))) (for-each (lambda (buf) (qt-setup-highlighting! app buf)) - (buffer-list)))) + (buffer-list)) + (when *terminal-theme-apply-hook* + (*terminal-theme-apply-hook*)))) (define *buffer-recent*--cell (vector '())) (def (buffer-touch! buf) "Record buffer as most recently used." @@ -1460,6 +1478,13 @@ (identifier-syntax [id (vector-ref *current-theme*--cell 0)] [(set! id val) (vector-set! *current-theme*--cell 0 val)])) + (define-syntax *terminal-theme-apply-hook* + (identifier-syntax + [id (vector-ref *terminal-theme-apply-hook*--cell 0)] + [(set! id val) (vector-set! + *terminal-theme-apply-hook*--cell + 0 + val)])) (define-syntax *buffer-recent* (identifier-syntax [id (vector-ref *buffer-recent*--cell 0)] --- a/lib/jerboa-emacs/qt/commands-shell.sls +++ b/lib/jerboa-emacs/qt/commands-shell.sls @@ -5,7 +5,8 @@ (library (jerboa-emacs qt commands-shell) (export directory-exists? *terminal-widget-map* *terminal-views-map* terminal-view-for-container - terminal-ensure-view! apply-font-size-to-all-editors! + terminal-ensure-view! apply-terminal-theme-to-session! + apply-terminal-theme-to-all! 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 @@ -142,6 +143,15 @@ (cons container view) (or (hash-get *terminal-views-map* buf) '()))) view))) + (def (apply-terminal-theme-to-session! term) + "Apply the current editor theme's default fg/bg colors to a native terminal." + (let-values ([(fg bg) (current-terminal-theme-colors)]) + (qt-terminal-set-colors! term fg bg))) + (def (apply-terminal-theme-to-all!) + "Apply the current theme to every live native terminal session." + (hash-for-each + (lambda (_buf term) (apply-terminal-theme-to-session! term)) + *terminal-widget-map*)) (def (apply-font-size-to-all-editors! app) "Apply the current global font size to all open editors." (let ([fr (app-state-frame app)] @@ -163,7 +173,8 @@ (qt-terminal-set-font! term *default-font-family* - *default-font-size*)) + *default-font-size*) + (apply-terminal-theme-to-session! term)) *terminal-widget-map*) (when *qt-app-ptr* (qt-app-set-style-sheet! *qt-app-ptr* (theme-stylesheet)))) @@ -2464,4 +2475,6 @@ (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)])) + (set-terminal-theme-apply-hook! + apply-terminal-theme-to-all!)) --- a/scripts/patch-jerboa-qt-compat.sh +++ b/scripts/patch-jerboa-qt-compat.sh @@ -11,8 +11,9 @@ # # Move make-time back to Chez's: drop it from the (except (chezscheme) ...) list # (so the Chez primitive is visible) and add it to the (except (jerboa prelude) -# ...) list (so the dt-raw one no longer shadows it). string-split/string-join -# stay excepted from the prelude exactly as before. Idempotent. +# ...) list (so the dt-raw one no longer shadows it). Also except +# string-split/string-join from the prelude when vendored qt.sls carries local +# helper definitions for those names. Idempotent. # # Patches the transpiled .sls (the build input — jerboa-qt's lib/ is used as-is, # not re-transpiled). Run from vendor-deps. @@ -42,14 +43,19 @@ fi if grep -q '(except (jerboa prelude) string-split string-join make-time)' "$qtsls"; then exit 0 fi -# Only patch the known committed form (make-time excepted from chezscheme + -# string-split/string-join excepted from prelude). -if grep -q 'make-date make-time meta atom?' "$qtsls" \ - && grep -q '(except (jerboa prelude) string-split string-join)' "$qtsls"; then +if grep -q 'make-date make-time meta atom?' "$qtsls"; then + sed_in_place "$qtsls" \ + -e 's/make-date make-time meta atom?/make-date meta atom?/' +fi + +if grep -q '(except (jerboa prelude) string-split string-join)' "$qtsls"; then sed_in_place "$qtsls" \ - -e 's/make-date make-time meta atom?/make-date meta atom?/' \ -e 's/(except (jerboa prelude) string-split string-join)/(except (jerboa prelude) string-split string-join make-time)/' echo "patch-jerboa-qt-compat: qt-app-exec! sleep now uses Chez make-time" +elif grep -q ' (jerboa prelude)' "$qtsls"; then + sed_in_place "$qtsls" \ + -e 's/ (jerboa prelude)/ (except (jerboa prelude) string-split string-join make-time)/' + echo "patch-jerboa-qt-compat: qt.sls prelude conflicts patched" else echo "patch-jerboa-qt-compat: qt.sls not in expected form; left unchanged" >&2 fi --- a/src/jerboa-emacs/qt/commands-config.ss +++ b/src/jerboa-emacs/qt/commands-config.ss @@ -785,7 +785,7 @@ modified so the next save uses the new encoding." (session (qt-terminal-create container)) (jsh-path (or (getenv "JSH") "/usr/local/bin/jsh"))) (qt-terminal-set-font! session *default-font-family* *default-font-size*) - (qt-terminal-set-colors! session #xbbc2cf #x282c34) + (apply-terminal-theme-to-session! session) ;; Map the session BEFORE creating the view: the post-buffer-attach ;; hook may fire re-entrantly and must find the session to attach a view. (hash-put! *terminal-widget-map* buf session) --- a/src/jerboa-emacs/qt/commands-core.ss +++ b/src/jerboa-emacs/qt/commands-core.ss @@ -202,6 +202,23 @@ (and theme (let ((pair (assoc key theme))) (and pair (cdr pair)))))) +(def (theme-hex-color->rgb-int color-str fallback) + "Convert #RRGGBB theme color strings to 0xRRGGBB integers." + (let-values (((r g b) (parse-hex-color (or color-str fallback)))) + (+ (* r 65536) (* g 256) b))) + +(def (current-terminal-theme-colors) + "Return default terminal foreground/background as 0xRRGGBB values." + (values + (theme-hex-color->rgb-int (theme-color 'fg) "#d8d8d8") + (theme-hex-color->rgb-int (theme-color 'bg) "#181818"))) + +(def *terminal-theme-apply-hook* #f) + +(def (set-terminal-theme-apply-hook! proc) + "Install a callback run after theme changes to update native terminal sessions." + (set! *terminal-theme-apply-hook* proc)) + (def (load-theme! theme-name) "Load a theme by applying its face definitions to the global *faces* registry." (let ((theme (theme-get theme-name))) @@ -300,7 +317,9 @@ (for-each (lambda (buf) (qt-setup-highlighting! app buf)) - (buffer-list)))) + (buffer-list)) + (when *terminal-theme-apply-hook* + (*terminal-theme-apply-hook*)))) ;; Buffer recency tracking (MRU order for buffer switching) (def *buffer-recent* []) ; list of buffer names, most recent first @@ -1480,4 +1499,3 @@ Returns (path . line) or #f. Handles file:line format." ((char=? (string-ref text j) #\)) (match (+ j 1) (- depth 1))) (else (match (+ j 1) depth))))) (else (find-start (+ i 1))))))) - --- a/src/jerboa-emacs/qt/commands-shell.ss +++ b/src/jerboa-emacs/qt/commands-shell.ss @@ -94,6 +94,20 @@ (or (hash-get *terminal-views-map* buf) '()))) view))) +(def (apply-terminal-theme-to-session! term) + "Apply the current editor theme's default fg/bg colors to a native terminal." + (let-values (((fg bg) (current-terminal-theme-colors))) + (qt-terminal-set-colors! term fg bg))) + +(def (apply-terminal-theme-to-all!) + "Apply the current theme to every live native terminal session." + (hash-for-each + (lambda (_buf term) + (apply-terminal-theme-to-session! term)) + *terminal-widget-map*)) + +(set-terminal-theme-apply-hook! apply-terminal-theme-to-all!) + ;; --- Font size --- ;; Note: Font size state is now in face.ss (*default-font-size*) @@ -114,7 +128,8 @@ ;; Apply font size to QTerminalWidget buffers (hash-for-each (lambda (_buf term) - (qt-terminal-set-font! term *default-font-family* *default-font-size*)) + (qt-terminal-set-font! term *default-font-family* *default-font-size*) + (apply-terminal-theme-to-session! term)) *terminal-widget-map*) ;; Update Qt stylesheet so chrome widgets match (when *qt-app-ptr* @@ -2010,4 +2025,3 @@ SPC = page down, DEL = page up, q = quit view-mode." (or (char=? (string-ref str i) #\q) (char=? (string-ref str i) (integer->char 3)) (scan (+ i 1))))))) - --- a/src/jerboa/repl-socket.ss +++ b/src/jerboa/repl-socket.ss @@ -196,12 +196,16 @@ (values fd actual-port)))) (def (repl-socket-accept listen-fd) - (let ((cfd (c-accept listen-fd 0 0))) - (cond - ((>= cfd 0) - (set-nonblocking! cfd) - cfd) - (else #f)))) + ;; Some platforms can silently fail the FIONBIO ioctl above. Poll first so + ;; callers that run on the UI/master timer never block in accept. + (if (eq? (repl-socket-poll listen-fd 0) 'ready) + (let ((cfd (c-accept listen-fd 0 0))) + (cond + ((>= cfd 0) + (set-nonblocking! cfd) + cfd) + (else #f))) + #f)) (def (repl-socket-read fd) (let ((buf (make-bytevector 1024))) --- a/support/vendor-overrides/qt_shim.cpp +++ b/support/vendor-overrides/qt_shim.cpp @@ -7897,11 +7897,11 @@ protected: QPainter p(this); QColor def_fg = m_session ? m_session->m_default_fg : QColor(0xC0,0xC0,0xC0); QColor def_bg = m_session ? m_session->m_default_bg : QColor(0x18,0x18,0x18); + p.fillRect(ev->rect(), def_bg); // No live screen yet (session gone or not initialized): clear and bail. VTermScreen* screen = m_session ? m_session->m_screen : nullptr; if (!screen) { - p.fillRect(ev->rect(), def_bg); return; } p.setFont(m_font);