updates
ober
4f8e6e4c17a94360eafb4b9dff4dfa155f5ca03c
--- a/Makefile +++ b/Makefile @@ -122,7 +122,7 @@ SCHEME_CHEZ_DIR = $(shell if [ -n "$(SCHEME_MT)" ]; then ls -d "$(SCHEME_PREFIX) CHEZ_DIR ?= $(SCHEME_CHEZ_DIR) export CHEZ_DIR -.PHONY: all vendor-deps check-pcre2-system-deps check-vterm-system-deps deps ensure-vendor-jerboa-tools scintilla-vendor-deps scintilla-vendor-clean build rebuild run test-tier0 test-tier2 test-tier3 test-tier4 test-tier5 test-org test-extra test clean clean-generated \ +.PHONY: all vendor-deps vendor-update check-pcre2-system-deps check-vterm-system-deps deps ensure-vendor-jerboa-tools scintilla-vendor-deps scintilla-vendor-clean build rebuild run test-tier0 test-tier2 test-tier3 test-tier4 test-tier5 test-org test-extra test clean clean-generated \ test-org-duration test-org-element test-org-fold test-org-footnote \ test-org-lint test-org-num test-org-property test-org-src test-org-tempo \ test-vtscreen test-debug-repl test-qt test-qt-e2e build-qt binary-qt \ @@ -227,6 +227,33 @@ vendor-deps: @scripts/patch-jerboa-aws-compat.sh "$(CURDIR)" @echo "=== Vendor complete ===" +# Fast-forward existing vendored git checkouts to current upstream HEAD. +# `make vendor-deps` only CLONES missing deps; it never updates an existing +# checkout, so a machine with old clones keeps building against stale sources +# (the usual cause of "No rule to make target 'jerboa'/'stage-jsqlite'" and +# pcre2 "multiple definitions for match"). This resets each tracked vendor/<dep> +# to origin HEAD. Gitignored build artifacts (.chez/, build/) are preserved; +# local patch-script edits re-apply on the next `make build`. +vendor-update: + @echo "=== Updating vendored git checkouts to upstream HEAD ===" + @for d in $(VENDOR)/*/ ; do \ + d=$${d%/}; \ + [ -d "$$d/.git" ] || continue; \ + cur=$$(git -C "$$d" rev-parse --short HEAD 2>/dev/null); \ + if git -C "$$d" fetch --depth 1 origin HEAD >/dev/null 2>&1; then \ + new=$$(git -C "$$d" rev-parse --short FETCH_HEAD 2>/dev/null); \ + if [ "$$cur" != "$$new" ]; then \ + git -C "$$d" reset --hard FETCH_HEAD >/dev/null 2>&1 \ + && echo " updated $$(basename $$d): $$cur -> $$new"; \ + else \ + echo " current $$(basename $$d): $$cur"; \ + fi; \ + else \ + echo " skip $$(basename $$d) (no reachable upstream)"; \ + fi; \ + done + @echo "=== vendor-update complete — run 'make build' to re-apply compat patches ===" + PCRE2_CHECK_CFLAGS := $(shell pkg-config --cflags libpcre2-8 2>/dev/null) PCRE2_CHECK_LIBS := $(shell pkg-config --libs libpcre2-8 2>/dev/null || echo -lpcre2-8) @@ -822,6 +849,7 @@ build-jemacs-qt-static: check-root --compile-imported-libraries --script /tmp/compile-jerboa-pcre2.ss && \ rm -rf /deps/jerboa-scintilla && mkdir -p /deps/jerboa-scintilla/src/jerboa-scintilla && \ cp /src/vendor/jerboa-scintilla/lib/jerboa-scintilla/*.sls /deps/jerboa-scintilla/src/jerboa-scintilla/ && \ + perl -0pi -e 's{\(load-shared-object\s+\(format "~a/jerboa_scintilla_shim\.~a" shim-dir shlib-ext\)\)}{(if (getenv "JEMACS_STATIC") #f (load-shared-object (format "~a/jerboa_scintilla_shim.~a" shim-dir shlib-ext)))}gs' /deps/jerboa-scintilla/src/jerboa-scintilla/ffi.sls && \ find /deps/jerboa-scintilla -name '*.so' -delete && \ find /deps/jerboa-scintilla -name '*.wpo' -delete && \ printf '%s\n' '(import (jerboa-scintilla constants) (jerboa-scintilla scintilla) (jerboa-scintilla ffi) (jerboa-scintilla style) (jerboa-scintilla tui))' > /tmp/compile-jerboa-scintilla.ss && \ @@ -923,7 +951,9 @@ linux-static-qt-podman: vendor-deps ensure-podman-deps echo 'SYNC: bulk-copying host jerboa std/ and jerboa/ into container...'; \ cp -a /host-jerboa-std/. /deps/jerboa/lib/std/ && \ cp -a /host-jerboa-core/. /deps/jerboa/lib/jerboa/ && \ + cp /src/vendor/jerboa/jerbuild.ss /deps/jerboa/jerbuild.ss && \ sh /src/scripts/patch-jerboa-std-compat.sh /deps/jerboa/lib && \ + sh /src/scripts/patch-static-load-shared.sh /deps/jerboa/lib && \ find /deps/jerboa/lib -name '*.so' -delete && \ find /deps/jerboa/lib -name '*.wpo' -delete && \ echo '(import (chezscheme)) (compile-imported-libraries #t) (generate-wpo-files #t) (import (jerboa core)) (import (jerboa prelude))' \ @@ -944,6 +974,7 @@ linux-static-qt-podman: vendor-deps ensure-podman-deps done && \ /opt/chez/bin/scheme --libdirs /deps/jerboa/lib --script support/jerbuild.ss jsh-src src --force && \ /opt/chez/bin/scheme --libdirs /deps/jerboa/lib --script support/jerbuild.ss jerboa-src/src src --force && \ + sh /src/scripts/patch-static-load-shared.sh /deps/jsh && \ printf '%s\n' '#!chezscheme' '(library (jsh embed-data)' \ ' (export %embed-file-table %embed-encrypted? %embed-salt %record-pubkey)' \ ' (import (chezscheme))' \ @@ -1062,7 +1093,9 @@ linux-static-tui-podman: vendor-deps ensure-podman-deps echo 'SYNC: bulk-copying host jerboa std/ and jerboa/ into container...'; \ cp -a /host-jerboa-std/. /deps/jerboa/lib/std/ && \ cp -a /host-jerboa-core/. /deps/jerboa/lib/jerboa/ && \ + cp /src/vendor/jerboa/jerbuild.ss /deps/jerboa/jerbuild.ss && \ sh /src/scripts/patch-jerboa-std-compat.sh /deps/jerboa/lib && \ + sh /src/scripts/patch-static-load-shared.sh /deps/jerboa/lib && \ find /deps/jerboa/lib -name '*.so' -delete && \ find /deps/jerboa/lib -name '*.wpo' -delete && \ echo '(import (chezscheme)) (compile-imported-libraries #t) (generate-wpo-files #t) (import (jerboa core)) (import (jerboa prelude))' \ @@ -1083,6 +1116,7 @@ linux-static-tui-podman: vendor-deps ensure-podman-deps done && \ /opt/chez/bin/scheme --libdirs /deps/jerboa/lib --script support/jerbuild.ss jsh-src src --force && \ /opt/chez/bin/scheme --libdirs /deps/jerboa/lib --script support/jerbuild.ss jerboa-src/src src --force && \ + sh /src/scripts/patch-static-load-shared.sh /deps/jsh && \ printf '%s\n' '#!chezscheme' '(library (jsh embed-data)' \ ' (export %embed-file-table %embed-encrypted? %embed-salt %record-pubkey)' \ ' (import (chezscheme))' \ --- a/build-binary-qt.ss +++ b/build-binary-qt.ss @@ -375,6 +375,14 @@ (list (format "~a/jerboa-pcre2/ffi.ss" pcre2-dir) (format "~a/jerboa-pcre2/ffi.sls" pcre2-dir)))) (include-dir chez-dir) + ;; jsh vendored deps (jsqlite, coreutils, sed, ssh, fuse) bind libc/shim + ;; symbols (e.g. usleep, coreutils_*) that must be registered too, now + ;; that static builds no longer load-shared-object at runtime to pull + ;; them in. Derive the paths from jsh-dir's parent (.../jsh/vendor). + (jsh-vendor-dirs + (let ((v (string-append (path-parent jsh-dir) "/vendor"))) + (format "~a/jsqlite/src ~a/jerboa-coreutils/lib ~a/jerboa-sed/lib ~a/jerboa-ssh/src ~a/jerboa-fuse/lib" + v v v v v))) ;; Generate the C file by scanning ALL FFI source files: ;; jerboa-qt/ffi.ss, jerboa-pcre2/ffi.ss — specific files ;; jsh-dir/, jerboa-dir/, jerboa-ssl-dir/src, lib/jerboa-emacs/ — recursive @@ -386,7 +394,7 @@ ;; define-foreign name "c-name" — jsh macro (C name is the second string) (gen-cmd (format - "{ { cat ~a ~a; find ~a ~a/jerboa ~a/std/os ~a/std/net ~a/std/crypto ~a/std/security ~a/jerboa-scintilla ~a/src lib/jerboa-emacs lib/jerboa -name '*.sls' -o -name '*.ss' | xargs cat 2>/dev/null; } | \ + "{ { cat ~a ~a; find ~a ~a/jerboa ~a/std/os ~a/std/net ~a/std/crypto ~a/std/security ~a/jerboa-scintilla ~a/src ~a lib/jerboa-emacs lib/jerboa -name '*.sls' -o -name '*.ss' | xargs cat 2>/dev/null; } | \ sed 's/;;.*//' | grep -oE '(foreign-procedure|foreign-entry\\?) \"[^\"]*\"' | sed 's/.* \"//;s/\"//'; \ { cat ~a ~a; } | sed 's/;;.*//' | grep -o 'define-optional-ffi [^ ]* \"[^\"]*\"' | sed 's/.*define-optional-ffi [^ ]* \"//;s/\"//'; \ find ~a -name '*.sls' -o -name '*.ss' | \ @@ -395,7 +403,7 @@ find ~a -name '*.sls' -o -name '*.ss' | \ sed 's/.*define-foreign [^ ]* *\"//;s/\".*//'; \ nm -g jemacs-qt-jsh-ffi.o 2>/dev/null | \ awk '$2 == \"T\" || $2 == \"t\" { print $NF }'; } | \ -sort -u | grep -v '^$' | grep -E '^[A-Za-z_][A-Za-z0-9_]*$' | grep -v '^_NSGetExecutablePath$' | grep -v '^io_uring_' | \ +sort -u | grep -v '^$' | grep -E '^[A-Za-z_][A-Za-z0-9_]*$' | grep -v '^_NSGetExecutablePath$' | grep -v '^io_uring_' | grep -v '^run_demo$' | \ grep -v '^jerboa_' | grep -v '^SSL_' | grep -v '^TLS_' | grep -v '^EVP_' | \ grep -v '^CRYPTO_' | grep -v '^PKCS5_' | grep -v '^RAND_' | grep -v '^HMAC$' | \ grep -v '^QRcode_' | grep -v '^embed_encrypt$' | grep -v '^embed_random_bytes$' | \ @@ -414,7 +422,7 @@ echo \"}\" >> qt_static_symbols.c && \ rm /tmp/ffi_syms.txt && \ echo OK" ffi-path pcre2-ffi-path - jsh-dir jerboa-dir jerboa-dir jerboa-dir jerboa-dir jerboa-dir sci-dir jerboa-ssl-dir + jsh-dir jerboa-dir jerboa-dir jerboa-dir jerboa-dir jerboa-dir sci-dir jerboa-ssl-dir jsh-vendor-dirs ffi-path pcre2-ffi-path jsh-dir)) (result (shell-output gen-cmd ""))) @@ -622,6 +630,40 @@ grep -v '^$' | grep -v '^register_static_foreign_symbols$'") (display "Error: jemacs-qt-main.c compilation failed\n") (exit 1))) +;; Static: (re)generate the foreign symbol registration table now that ALL C +;; shim objects are compiled. A -static musl binary has no usable dynsym, so +;; foreign-procedure resolves only via Sforeign_symbol; the generator registers +;; every symbol actually DEFINED in the linked objects (jerboa_qt_*, +;; jerboa_scintilla_*, coreutils_*, ...) plus libc names from a source scan. +;; This supersedes the earlier (partial) table built before the shims existed. +(when jemacs-static? + (let* ((ffi-path + (first-existing-file + (list (format "~a/jerboa-qt/ffi.ss" qt-dir) + (format "~a/jerboa-qt/ffi.sls" qt-dir)))) + (pcre2-ffi-path + (first-existing-file + (list (format "~a/jerboa-pcre2/ffi.ss" pcre2-dir) + (format "~a/jerboa-pcre2/ffi.sls" pcre2-dir)))) + (jsh-vendor (string-append (path-parent jsh-dir) "/vendor")) + (scan-roots + (format "~a ~a ~a ~a/jerboa ~a/std/os ~a/std/net ~a/std/crypto ~a/std/security ~a/jerboa-scintilla ~a/src ~a/jsqlite/src ~a/jerboa-coreutils/lib ~a/jerboa-sed/lib ~a/jerboa-ssh/src ~a/jerboa-fuse/lib lib/jerboa-emacs lib/jerboa" + (or ffi-path "") (or pcre2-ffi-path "") jsh-dir + jerboa-dir jerboa-dir jerboa-dir jerboa-dir jerboa-dir + sci-dir jerboa-ssl-dir + jsh-vendor jsh-vendor jsh-vendor jsh-vendor jsh-vendor)) + (cmd (format "sh scripts/gen-static-symbols.sh qt_static_symbols.c ~a ~a" + qt-shim-dir scan-roots))) + (printf " Regenerating static symbol table (nm of linked objects + source scan)...~n") + (unless (= 0 (system cmd)) + (display "Error: gen-static-symbols.sh failed\n") + (exit 1)) + (let ((ccmd (format "gcc -c -O2 -o qt_static_symbols.o qt_static_symbols.c -I~a -Wall 2>&1" + chez-dir))) + (unless (= 0 (system ccmd)) + (display "Error: qt_static_symbols.c (final) compilation failed\n") + (exit 1))))) + ;; --- Step 6: Link native binary --- (printf "[6/7] Linking native binary...~n") (if jemacs-static? --- a/lib/jerboa-emacs/async.sls +++ b/lib/jerboa-emacs/async.sls @@ -552,8 +552,8 @@ (let ([v (hashtable-ref cache key - '#{miss ex09hydq9y29d6vkzpuysk4du-0})]) - (if (eq? v '#{miss ex09hydq9y29d6vkzpuysk4du-1}) + '#{miss cakb0pz8vux0ab3uibm2wew4v-1})]) + (if (eq? v '#{miss cakb0pz8vux0ab3uibm2wew4v-2}) (if (null? default) #f (car default)) v))) (def (weak-cache-set! cache key value) --- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -10,11 +10,11 @@ mutex? mutex-name) (std sugar) (std misc string) (jerboa-scintilla constants) (jerboa-emacs qt sci-shim) - (except (jerboa-qt qt) QT_MOD_NONE QT_MOD_SHIFT QT_MOD_CONTROL - QT_MOD_ALT QT_MOD_META QT_KEY_ESCAPE QT_KEY_BACKSPACE - QT_KEY_RETURN QT_KEY_ENTER QT_KEY_DELETE QT_KEY_TAB - QT_KEY_BACKTAB QT_KEY_INSERT QT_KEY_HOME QT_KEY_END - QT_KEY_LEFT QT_KEY_RIGHT QT_KEY_UP QT_KEY_DOWN + (except (jerboa-qt qt) QT_MOD_NONE QT_MOD_SHIFT + QT_MOD_CONTROL QT_MOD_ALT QT_MOD_META QT_KEY_ESCAPE + QT_KEY_BACKSPACE QT_KEY_RETURN QT_KEY_ENTER QT_KEY_DELETE + QT_KEY_TAB QT_KEY_BACKTAB QT_KEY_INSERT QT_KEY_HOME + QT_KEY_END QT_KEY_LEFT QT_KEY_RIGHT QT_KEY_UP QT_KEY_DOWN QT_KEY_PAGE_UP QT_KEY_PAGE_DOWN QT_KEY_SPACE QT_KEY_F1 QT_KEY_F2 QT_KEY_F3 QT_KEY_F4 QT_KEY_F5 QT_KEY_F6 QT_KEY_F7 QT_KEY_F8 QT_KEY_F9 QT_KEY_F10 QT_KEY_F11 QT_KEY_F12 @@ -775,8 +775,7 @@ "commands registered: " (number->string (hash-length *all-commands*)) " total") - (let ([image-key-installed (make-hash-table-eq)] - [terminal-key-installed (make-hash-table-eq)]) + (let ([image-key-installed (make-hash-table-eq)]) (add-hook! 'post-buffer-attach-hook (lambda (editor buf) @@ -789,24 +788,23 @@ (lambda () (cond [(hash-get *terminal-widget-map* buf) => - (lambda (term) + (lambda (session) (let ([win (hash-get *editor-window-map* editor)]) (when win (let* ([container (qt-edit-window-container win)] - [count (qt-stacked-widget-count - container)] - [tw (qt-terminal-widget term)]) - (unless (hash-get terminal-key-installed tw) - ((app-state-key-handler app) tw) - (hash-put! terminal-key-installed tw #t)) - (if (> count 1) - (begin - (qt-stacked-widget-set-current-widget! - container - tw) - (qt-widget-set-focus! tw)) - (qt-widget-set-focus! editor))))))] + [view (terminal-ensure-view! + app + buf + session + container)]) + (qt-stacked-widget-set-current-widget! + container + view) + (when (eq? win + (qt-current-window + (app-state-frame app))) + (qt-terminal-view-focus! view))))))] [(image-buffer? buf) (qt-show-image-buffer! editor buf) (let ([win (hash-get *editor-window-map* editor)]) @@ -1579,10 +1577,21 @@ qt-buf))] [key-src-widget (qt-last-key-widget)] [key-from-terminal? (and qt-term - (equal? - key-src-widget - (qt-terminal-widget - qt-term)))]) + (let loop ([views (or (hash-get + *terminal-views-map* + qt-buf) + '())]) + (cond + [(null? + views) + #f] + [(equal? + key-src-widget + (cdr (car views))) + #t] + [else + (loop + (cdr views))])))]) (if (and qt-term key-from-terminal? (null? @@ -1839,30 +1848,52 @@ (qt-on-key-press-consuming! editor key-handler))) (automation-set-key-target-fn! (lambda (fr) - (let* ([buf (qt-current-buffer fr)] - [term (and buf - (hash-get *terminal-widget-map* buf))]) - (if term - (qt-terminal-widget term) - (qt-current-editor fr))))) + (let* ([win (qt-current-window fr)] + [buf (qt-edit-window-buffer win)] + [view (and buf + (hash-get *terminal-widget-map* buf) + (terminal-view-for-container + buf + (qt-edit-window-container win)))]) + (or view (qt-current-editor fr))))) (qt-window-set-pre-container-destroy-fn! (lambda (container) - (let ([bufs-to-remove '()]) + (let ([entries '()]) (hash-for-each - (lambda (buf stored-container) - (when (equal? stored-container container) - (let ([term (hash-get *terminal-widget-map* buf)]) - (when term - (with-catch - (lambda (e) #f) - (lambda () (qt-terminal-destroy! term))))) - (set! bufs-to-remove (cons buf bufs-to-remove)))) - *terminal-container-map*) + (lambda (buf views) + (set! entries (cons (cons buf views) entries))) + *terminal-views-map*) (for-each - (lambda (buf) - (hash-remove! *terminal-widget-map* buf) - (hash-remove! *terminal-container-map* buf)) - bufs-to-remove))))) + (lambda (e) + (let* ([buf (car e)] + [views (cdr e)] + [mine (filter + (lambda (cv) + (equal? (car cv) container)) + views)] + [rest (filter + (lambda (cv) + (not (equal? (car cv) container))) + views)]) + (unless (null? mine) + (for-each + (lambda (cv) + (with-catch + (lambda (e) #f) + (lambda () + (qt-terminal-view-destroy! (cdr cv))))) + mine) + (hash-put! *terminal-views-map* buf rest)))) + entries))))) + (qt-window-set-post-split-focus-fn! + (lambda (new-win) + (let* ([buf (qt-edit-window-buffer new-win)] + [session (and buf + (hash-get *terminal-widget-map* buf))]) + (and session + (terminal-view-for-container + buf + (qt-edit-window-container new-win)))))) (schedule-periodic! 'repl-poll 50 @@ -2577,19 +2608,16 @@ (let* ([fr (app-state-frame app)] [win (qt-current-window fr)] [buf (qt-edit-window-buffer win)] - [term (and buf - (hash-get - *terminal-widget-map* - buf))]) - (and term - (let* ([container (qt-edit-window-container - win)] - [count (qt-stacked-widget-count - container)]) - (and (> count 1) - (> (qt-stacked-widget-current-index - container) - 0))))))) + [session (and buf + (hash-get + *terminal-widget-map* + buf))] + [container (qt-edit-window-container win)]) + (and session + (terminal-view-for-container buf container) + (> (qt-stacked-widget-current-index container) + 0) + #t)))) (cons 'test-reset! (lambda () @@ -2597,17 +2625,15 @@ (let ([term-bufs (hash-keys *terminal-widget-map*)]) (for-each (lambda (buf) - (let ([term (hash-get - *terminal-widget-map* - buf)]) - (when term + (let ([session (hash-get + *terminal-widget-map* + buf)]) + (when session (with-catch (lambda (e) #f) - (lambda () (qt-terminal-destroy! term))) + (lambda () (qt-terminal-destroy! session))) (hash-remove! *terminal-widget-map* buf) - (hash-remove! - *terminal-container-map* - buf)))) + (hash-remove! *terminal-views-map* buf)))) term-bufs)) (when (> (length (qt-frame-windows (app-state-frame app))) --- a/lib/jerboa-emacs/qt/automation.sls +++ b/lib/jerboa-emacs/qt/automation.sls @@ -12,11 +12,11 @@ getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name) (std sugar) (jerboa-emacs qt sci-shim) - (except (jerboa-qt qt) QT_MOD_NONE QT_MOD_SHIFT QT_MOD_CONTROL - QT_MOD_ALT QT_MOD_META QT_KEY_ESCAPE QT_KEY_BACKSPACE - QT_KEY_RETURN QT_KEY_ENTER QT_KEY_DELETE QT_KEY_TAB - QT_KEY_BACKTAB QT_KEY_INSERT QT_KEY_HOME QT_KEY_END - QT_KEY_LEFT QT_KEY_RIGHT QT_KEY_UP QT_KEY_DOWN + (except (jerboa-qt qt) QT_MOD_NONE QT_MOD_SHIFT + QT_MOD_CONTROL QT_MOD_ALT QT_MOD_META QT_KEY_ESCAPE + QT_KEY_BACKSPACE QT_KEY_RETURN QT_KEY_ENTER QT_KEY_DELETE + QT_KEY_TAB QT_KEY_BACKTAB QT_KEY_INSERT QT_KEY_HOME + QT_KEY_END QT_KEY_LEFT QT_KEY_RIGHT QT_KEY_UP QT_KEY_DOWN QT_KEY_PAGE_UP QT_KEY_PAGE_DOWN QT_KEY_SPACE QT_KEY_F1 QT_KEY_F2 QT_KEY_F3 QT_KEY_F4 QT_KEY_F5 QT_KEY_F6 QT_KEY_F7 QT_KEY_F8 QT_KEY_F9 QT_KEY_F10 QT_KEY_F11 QT_KEY_F12 --- a/lib/jerboa-emacs/qt/commands-config.sls +++ b/lib/jerboa-emacs/qt/commands-config.sls @@ -899,8 +899,8 @@ (loop (cdr segs) (+ pos text-len))))))) (define terminal-buffer-counter--cell (vector 0)) (def (cmd-term app) - "Open a QTerminalWidget-backed terminal running jsh as the shell." - (verbose-log! "cmd-term: begin (QTerminalWidget + jsh)") + "Open a QTerminalSession-backed terminal running jsh as the shell.\n The session is shared by all windows showing the buffer; each window gets\n its own QTerminalView, so splitting the window shows the same live terminal." + (verbose-log! "cmd-term: begin (QTerminalSession + jsh)") (let* ([fr (app-state-frame app)] [ed (current-qt-editor app)] [name (begin @@ -927,24 +927,22 @@ (lambda () (let* ([win (qt-current-window fr)] [container (qt-edit-window-container win)] - [term (qt-terminal-create container)] + [session (qt-terminal-create container)] [jsh-path (or (getenv "JSH") "/usr/local/bin/jsh")]) (qt-terminal-set-font! - term + session *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) + (qt-terminal-set-colors! session 12305103 2632756) + (hash-put! *terminal-widget-map* buf session) + (let ([view (terminal-ensure-view! + app + buf + session + container)]) + (qt-stacked-widget-set-current-widget! container view) + (qt-terminal-view-focus! view) + (qt-terminal-spawn! session jsh-path)) (verbose-log! "cmd-term: spawned jsh=" jsh-path) (echo-message! (app-state-echo app) --- a/lib/jerboa-emacs/qt/commands-shell.sls +++ b/lib/jerboa-emacs/qt/commands-shell.sls @@ -4,7 +4,8 @@ (library (jerboa-emacs qt commands-shell) (export directory-exists? *terminal-widget-map* - *terminal-container-map* apply-font-size-to-all-editors! + *terminal-views-map* terminal-view-for-container + terminal-ensure-view! 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 @@ -118,8 +119,27 @@ (and (file-exists? path) (file-directory? path))) (define *terminal-widget-map*--cell (vector (make-hash-table-eq))) - (define *terminal-container-map*--cell + (define *terminal-views-map*--cell (vector (make-hash-table-eq))) + (def (terminal-view-for-container buf container) + "Return the QTerminalView showing terminal BUF inside CONTAINER, or #f.\n Containers are foreign pointers, so compare with equal? (via assoc)." + (let ([views (hash-get *terminal-views-map* buf)]) + (cond + [(and views (assoc container views)) => cdr] + [else #f]))) + (def (terminal-ensure-view! app buf session container) + "Get or create the QTerminalView showing SESSION inside CONTAINER. Adds it as\n a QStackedWidget page and installs the consuming key filter exactly once.\n Returns the view." + (or (terminal-view-for-container buf container) + (let ([view (qt-terminal-view-create session container)]) + (qt-stacked-widget-add-widget! container view) + (let ([kh (app-state-key-handler app)]) (when kh (kh view))) + (hash-put! + *terminal-views-map* + buf + (cons + (cons container view) + (or (hash-get *terminal-views-map* buf) '()))) + view))) (def (apply-font-size-to-all-editors! app) "Apply the current global font size to all open editors." (let ([fr (app-state-frame app)] @@ -2280,11 +2300,11 @@ *terminal-widget-map*--cell 0 val)])) - (define-syntax *terminal-container-map* + (define-syntax *terminal-views-map* (identifier-syntax - [id (vector-ref *terminal-container-map*--cell 0)] + [id (vector-ref *terminal-views-map*--cell 0)] [(set! id val) (vector-set! - *terminal-container-map*--cell + *terminal-views-map*--cell 0 val)])) (define-syntax *auto-indent* --- a/lib/jerboa-emacs/qt/commands.sls +++ b/lib/jerboa-emacs/qt/commands.sls @@ -5,7 +5,8 @@ (library (jerboa-emacs qt commands) (export qt-register-all-commands! dired-open-directory! qt-open-image-inline! *qt-app-ptr* *terminal-widget-map* - *terminal-container-map* qt-kill-ring-push! *isearch-active* + *terminal-views-map* terminal-view-for-container + terminal-ensure-view! qt-kill-ring-push! *isearch-active* isearch-handle-key! *qreplace-active* qreplace-handle-key! recent-files-add! recent-files-load! bookmarks-load! session-save! session-restore-files *tab-bar-visible* @@ -662,6 +663,15 @@ (when ts (terminal-stop! ts) (hash-remove! *terminal-state* buf))) + (let ([session (hash-get + *terminal-widget-map* + buf)]) + (when session + (with-catch + (lambda (e) #f) + (lambda () (qt-terminal-destroy! session))) + (hash-remove! *terminal-widget-map* buf) + (hash-remove! *terminal-views-map* buf))) (let ([cs (hash-get *chat-state* buf)]) (when cs (chat-stop! cs) @@ -710,6 +720,13 @@ (when ts (terminal-stop! ts) (hash-remove! *terminal-state* buf))) + (let ([session (hash-get *terminal-widget-map* buf)]) + (when session + (with-catch + (lambda (e) #f) + (lambda () (qt-terminal-destroy! session))) + (hash-remove! *terminal-widget-map* buf) + (hash-remove! *terminal-views-map* 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 @@ -142,7 +142,8 @@ 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-widget qt-terminal-view-create + qt-terminal-view-destroy! qt-terminal-view-focus!) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -255,6 +256,15 @@ (def QT_CURSOR_NEXT_WORD 15) (def QT_CURSOR_PREVIOUS_CHAR 5) (def QT_CURSOR_PREVIOUS_WORD 18) + (def ffi-qt-stacked-widget-set-current-widget + (foreign-procedure "qt_stacked_widget_set_current_widget" + (void* void*) + void)) + (def (qt-stacked-widget-set-current-widget! sw widget) + (ffi-qt-stacked-widget-set-current-widget sw widget)) + (def ffi-qt-last-key-widget + (foreign-procedure "qt_last_key_widget" () void*)) + (def (qt-last-key-widget) (ffi-qt-last-key-widget)) (def (sci-check-handle! caller sci) (unless sci (error 'sci-check-handle! @@ -669,9 +679,24 @@ "Give keyboard focus to the terminal widget." ((foreign-procedure "qt_terminal_focus" (void*) void) term)) (def (qt-terminal-widget term) - "Return the QWidget* pointer for the terminal (for adding to QStackedWidget)." + "Return a representative view (active-or-first) of the terminal SESSION as a\n QWidget* pointer. Compatibility shim — prefer qt-terminal-view-* for views." ((foreign-procedure "qt_terminal_widget" (void*) void*) term)) + (def (qt-terminal-view-create session parent) + "Create a QTerminalView of SESSION parented into PARENT (a QStackedWidget).\n Registers the view with the session; returns the view's QWidget* pointer." + ((foreign-procedure "qt_terminal_view_create" + (void* void*) + void*) + session + parent)) + (def (qt-terminal-view-destroy! view) + "Destroy a single terminal VIEW (detach from its stack, unregister, delete).\n The owning session and its PTY/shell are left running." + ((foreign-procedure "qt_terminal_view_destroy" (void*) void) + view)) + (def (qt-terminal-view-focus! view) + "Give keyboard focus to a specific terminal VIEW." + ((foreign-procedure "qt_terminal_view_focus" (void*) void) + view)) (define-syntax *doc-editor-map* (identifier-syntax [id (vector-ref *doc-editor-map*--cell 0)] --- a/lib/jerboa-emacs/qt/window.sls +++ b/lib/jerboa-emacs/qt/window.sls @@ -29,7 +29,8 @@ qt-apply-editor-theme! split-tree-flatten split-tree-find-parent split-tree-find-leaf split-tree-collect-sub-splitters qt-window-set-app-ptr! - qt-window-set-pre-container-destroy-fn!) + qt-window-set-pre-container-destroy-fn! + qt-window-set-post-split-focus-fn!) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -44,6 +45,9 @@ (def *pre-container-destroy-fn* #f) (def (qt-window-set-pre-container-destroy-fn! fn) (set! *pre-container-destroy-fn* fn)) + (def *post-split-focus-fn* #f) + (def (qt-window-set-post-split-focus-fn! fn) + (set! *post-split-focus-fn* fn)) (def (qt-window-pre-container-destroy! container) (when *pre-container-destroy-fn* (*pre-container-destroy-fn* container))) @@ -530,6 +534,8 @@ [new-win (make-qt-edit-window new-ed container buf lna #f #f)]) (qt-scintilla-setup-editor! new-ed) + (qt-stacked-widget-add-widget! container new-ed) + (hash-put! *editor-window-map* new-ed new-win) (qt-buffer-attach! new-ed buf) (let loop ([i 0]) (when (<= i 127) @@ -556,7 +562,6 @@ SCI_STYLESETFORE STYLE_LINENUMBER (rgb->sci r g b))))) - (qt-stacked-widget-add-widget! container new-ed) (if insert-index (qt-safe-splitter-insert-widget! "qt-make-new-window!" @@ -567,7 +572,6 @@ "qt-make-new-window!" container-parent container)) - (hash-put! *editor-window-map* new-ed new-win) new-win)) (def (qt-frame-init! main-win splitter) "Create frame with one QScintilla editor in a QStackedWidget in a QSplitter.\n Returns the frame struct." @@ -577,13 +581,13 @@ [lna (qt-line-number-area-create editor)] [win (make-qt-edit-window editor container buf lna #f #f)]) (qt-scintilla-setup-editor! editor) - (qt-buffer-attach! editor buf) (qt-stacked-widget-add-widget! container editor) + (hash-put! *editor-window-map* editor win) + (qt-buffer-attach! editor buf) (qt-safe-splitter-add-widget! "qt-frame-init!" splitter container) - (hash-put! *editor-window-map* editor win) (let* ([root (make-split-leaf win)] [fr (make-qt-frame splitter root (list win) 0 main-win)]) (qt-frame-update-visual-indicators! fr) @@ -597,16 +601,7 @@ [cur-leaf (split-tree-find-leaf (qt-frame-root fr) cur-win)] [parent (split-tree-find-parent (qt-frame-root fr) cur-win)] [cur-buf (qt-edit-window-buffer cur-win)] - [new-buf (if (eq? (buffer-lexer-lang cur-buf) 'terminal) - (or (find - (lambda (b) - (string=? - (buffer-name b) - buffer-scratch-name)) - (map qt-edit-window-buffer - (qt-frame-windows fr))) - cur-buf) - cur-buf)] + [new-buf cur-buf] [main-win (qt-frame-main-win fr)] [saved-w (and main-win (qt-widget-width main-win))] [saved-h (and main-win (qt-widget-height main-win))]) @@ -759,7 +754,14 @@ saved-w saved-h)) (when result - (qt-safe-widget-set-focus! "qt-frame-do-split!" result)) + (let ([override (and *post-split-focus-fn* + (*post-split-focus-fn* + (list-ref + (qt-frame-windows fr) + (qt-frame-current-idx fr))))]) + (qt-safe-widget-set-focus! + "qt-frame-do-split!" + (or override result)))) (qt-frame-update-visual-indicators! fr) (when main-win (qt-safe-widget-set-updates-enabled! new file mode 100755 --- /dev/null +++ b/scripts/gen-static-symbols.sh @@ -0,0 +1,89 @@ +#!/bin/sh +# gen-static-symbols.sh OUT_C QT_SHIM_DIR SCAN_ROOT... +# +# Generate the C file that registers foreign symbols via Sforeign_symbol for the +# fully-static jemacs-qt binary. A `-static` musl binary has no usable dynamic +# symbol table (nm -D is empty), so Chez's foreign-procedure/foreign-entry? +# resolve ONLY through Sforeign_symbol — every FFI entry point must be +# registered here, and every registered name must actually resolve at link time +# or the link fails with "undefined reference". +# +# Two sources of truth, unioned: +# Path 1 — symbols DEFINED in the linked local objects (jemacs-qt-*.o, +# libqt_shim.a, qt_static_plugins.o). These are present, so they are +# always safe to register (jerboa_qt_*, jerboa_scintilla_*, +# coreutils_*, jerboa_landlock_*, ...). No exclusion list needed. +# Path 2 — FFI names referenced in Scheme sources but NOT defined locally: +# libc symbols (usleep, ...) that the strong (void*)X reference pulls +# from libc.a. These pass through an exclusion list that drops symbols +# known to be unlinked in the default (non-AWS) build (EVP_*, SSL_*, +# jerboa_ssh_*, ...), which would otherwise break the link. +# +# Only candidate names actually referenced by the Scheme FFI are registered, so +# the table stays scoped to real entry points. +set -eu + +out="$1"; qt_shim_dir="$2"; shift 2 + +tmp_cand=$(mktemp); tmp_def=$(mktemp); tmp_reg=$(mktemp); tmp_src=$(mktemp) +trap 'rm -f "$tmp_cand" "$tmp_def" "$tmp_reg" "$tmp_src"' EXIT INT TERM + +# ---- Candidate FFI symbol names referenced in Scheme sources ---------------- +for root in "$@"; do + if [ -d "$root" ]; then + find "$root" \( -name '*.ss' -o -name '*.sls' \) -print 2>/dev/null + elif [ -f "$root" ]; then + printf '%s\n' "$root" + fi +done | xargs cat 2>/dev/null | sed 's/;;.*//' > "$tmp_src" || true + +{ + grep -oE '(foreign-procedure|foreign-entry\?) "[^"]*"' "$tmp_src" \ + | sed 's/.* "//; s/"//' + grep -oE 'define-optional-ffi [^ ]* "[^"]*"' "$tmp_src" \ + | sed 's/.*define-optional-ffi [^ ]* "//; s/"//' + tr '\n' ' ' < "$tmp_src" \ + | grep -oE 'define-foreign [^ ]+ +"[^"]+"' \ + | sed 's/.*define-foreign [^ ]* *"//; s/".*//' +} | grep -E '^[A-Za-z_][A-Za-z0-9_]*$' | sort -u > "$tmp_cand" + +# ---- Symbols GLOBALLY defined in the linked local objects ------------------- +# These are the C-side FFI entry points the binary actually contains +# (jerboa_qt_*, ffi_* from jsh, coreutils_*, jerboa_scintilla_*, ...). Register +# ALL of them, not just those the source scan recognized: jsh's macros +# (define-jsh-foreign) hide the C name from a textual scan, so intersecting with +# scanned candidates would drop real entry points like ffi_fcntl_dupfd. They are +# defined, so registering them can never cause an undefined-reference link error. +# shellcheck disable=SC2086 +nm jemacs-qt-*.o "$qt_shim_dir/libqt_shim.a" "$qt_shim_dir/qt_static_plugins.o" 2>/dev/null \ + | awk '$2=="T" || $2=="W" { print $NF }' \ + | grep -E '^[A-Za-z_][A-Za-z0-9_]*$' \ + | grep -vE '^(main|register_static_foreign_symbols|_start|_init|_fini)$' \ + | sort -u > "$tmp_def" + +# Path 1: every globally-defined entry point in the linked objects. +cp "$tmp_def" "$tmp_reg" + +# Path 2: source-scanned candidate names NOT defined locally (libc symbols such +# as usleep, pulled from libc.a by the strong (void*)X reference), minus the +# known-unlinked prefixes/exact-names that would break the static link. +comm -23 "$tmp_cand" "$tmp_def" \ + | grep -vE '^(jerboa_|SSL_|TLS_|EVP_|CRYPTO_|PKCS5_|RAND_|QRcode_|sandbox_|cap_|mach_|io_uring_|host_statistics)' \ + | grep -vE '^(HMAC|embed_encrypt|embed_random_bytes|kqueue|kevent|__error|__errno|sysctlbyname|_NSGetExecutablePath|run_demo|register_static_foreign_symbols)$' \ + >> "$tmp_reg" + +sort -u "$tmp_reg" | grep -v '^$' > "$tmp_cand" + +# ---- Emit C ----------------------------------------------------------------- +{ + echo '/* Auto-generated by gen-static-symbols.sh — do not edit */' + echo '#include "scheme.h"' + echo '' + while IFS= read -r s; do printf 'extern void %s(void);\n' "$s"; done < "$tmp_cand" + echo '' + echo 'void register_static_foreign_symbols(void) {' + while IFS= read -r s; do printf ' Sforeign_symbol("%s", (void*)%s);\n' "$s" "$s"; done < "$tmp_cand" + echo '}' +} > "$out" + +printf 'gen-static-symbols: %s symbols -> %s\n' "$(wc -l < "$tmp_cand" | tr -d ' ')" "$out" new file mode 100755 --- /dev/null +++ b/scripts/patch-static-load-shared.sh @@ -0,0 +1,73 @@ +#!/bin/sh +# patch-static-load-shared.sh DIR +# +# Neutralize init-time (load-shared-object ...) calls for fully-static (musl) +# builds. In a static binary dlopen is unavailable; on musl a failed dlopen +# leaves dlerror()==NULL, so Chez's load_shared_object segfaults in +# strlen(NULL) (via Sstring_utf8) BEFORE any Scheme `guard`/`try` can catch it. +# +# Symbols that ARE needed are linked and registered via Sforeign_symbol (see +# build-binary-qt.ss), so foreign-procedure resolves them without any dynamic +# load. This patch removes the now-pointless (and crashing) load attempts. +# +# Mirrors the (load-shared-object #f) -> (void) patch in jerboa-shell's +# build-jsh-freebsd.ss, extended for musl's "" and named-library variants, and +# for the "did the lib load?" idiom used by optional-library wrappers. +# +# ONLY run this against the in-container dependency trees of a static build — +# never the host sources, which still need working dynamic loading. +set -eu + +dir="$1" + +# OpenSSL (libcrypto/libssl) symbols are deliberately EXCLUDED from the static +# symbol table (build-binary-qt.ss strips ^EVP_/^SSL_/^CRYPTO_/... ) because +# they are only linked for AWS/SSL feature builds. Modules gate their eager +# (foreign-procedure "EVP_...") forms on a "_loaded" flag computed as +# (try (begin (load-shared-object "libcrypto.so") #t) (catch (e) #f)) +# The hardcoded #t means simply removing the inner load still yields a truthy +# flag, so the unresolved EVP_* form is bound and crashes with "no entry". +# Collapse the whole begin to #f so the wrapper takes its stub branch. +# (libc/native flags keep #t — those symbols ARE registered.) +# +# Use perl -0777 (whole-file) because some modules (std crypto native) split the +# begin across lines: "(begin (load-shared-object \"libcrypto.so\")\n #t)". +find "$dir" \( -name '*.ss' -o -name '*.sls' \) -print | while IFS= read -r f; do + perl -0777 -pi \ + -e 's/\(begin\s+\(load-shared-object\s+"libcrypto[^"]*"\)\s+#t\)/#f/gs;' \ + -e 's/\(begin\s+\(load-shared-object\s+"libssl[^"]*"\)\s+#t\)/#f/gs;' \ + "$f" +done + +# Literal-argument forms: #f, "", and any "libNAME...", "./...", "/..." path. +# These cover libc.so*, libjerboa_native*, libSystem*, etc. Replace with #f +# (the convention the jerboa-qt FFI already uses for its static-skip branch). +find "$dir" \( -name '*.ss' -o -name '*.sls' \) -print | while IFS= read -r f; do + sed -i \ + -e 's|(load-shared-object #f)|#f|g' \ + -e 's|(load-shared-object "")|#f|g' \ + -e 's|(load-shared-object "lib[^"]*")|#f|g' \ + -e 's|(load-shared-object "\./[^"]*")|#f|g' \ + -e 's|(load-shared-object "/[^"]*")|#f|g' \ + "$f" +done + +# Variable-argument init-time loads the literal patterns miss. These iterate a +# list whose first element is #f / a libc path (std os errno) or take the path +# from a macro pattern var (std foreign bind). Wrap each so it is skipped when +# the binary is static; symbols are resolved via Sforeign_symbol instead. +find "$dir" \( -name '*.ss' -o -name '*.sls' \) -print | while IFS= read -r f; do + sed -i \ + -e 's|(load-shared-object lib)|(if (getenv "JEMACS_STATIC") #f (load-shared-object lib))|g' \ + -e 's|(load-shared-object so-name)|(if (getenv "JEMACS_STATIC") #f (load-shared-object so-name))|g' \ + "$f" +done + +# jsh's (jsh ffi) loader passes the path through a variable, so the literal +# patterns above miss it. Guard the helper body to skip dynamic loading when +# the binary is static (the binary sets JEMACS_STATIC=1). +find "$dir" -name 'ffi.sls' -path '*jsh*' -print | while IFS= read -r f; do + sed -i \ + -e 's|(guard (e \[#t (void)\]) (load-shared-object name))|(if (getenv "JEMACS_STATIC") (void) (guard (e [#t (void)]) (load-shared-object name)))|g' \ + "$f" +done --- a/vendor/jerboa-https +++ b/vendor/jerboa-https @@ -1 +1 @@ -Subproject commit 3bc7a40adcade47a776501ca9447cd501d63ad09 +Subproject commit 966c2f83e746e0153c7a843b235d8a2e466e1560 --- a/vendor/jerboa-pcre2 +++ b/vendor/jerboa-pcre2 @@ -1 +1 @@ -Subproject commit 719751bc7ef3e408e9da1a260393859f8bed9ea8 +Subproject commit a5faf099a90ccf85afdf6a0246558068530b2974 --- a/vendor/jerboa-qt +++ b/vendor/jerboa-qt @@ -1 +1 @@ -Subproject commit dc86e8354ed3406066e9ce7482c0d1d43e4c6272 +Subproject commit 2c8919003c5c4de9389f43c6296bcff86c51bc4e --- a/vendor/jerboa-scintilla +++ b/vendor/jerboa-scintilla @@ -1 +1 @@ -Subproject commit 96745c5ea69c95f1c4fa2ce80f43e9cdf59a55a6 +Subproject commit e74af96d9bfa0a91d2bf71aa6f32fc5a1691b070 --- a/vendor/jerboa-ssl +++ b/vendor/jerboa-ssl @@ -1 +1 @@ -Subproject commit f466a3149f6c9a0e6f8dd202e00bb746a9bacd2c +Subproject commit 8a43d646f65ec757f6c4b9fc2271de6fb25de9b0