Fix jemacs-qt: remove gerbil-qt deps, fix static binary startup
ober
57e2446bba2ca74e0a5959970358ca8d025cebc9
--- a/CLAUDE.md +++ b/CLAUDE.md @@ -17,8 +17,26 @@ make build # Translate src/*.ss → lib/*.sls (incremental) make rebuild # Force full retranslation make run # Build and run TUI editor make run-qt # Build and run Qt editor +make static-qt # Build static jemacs-qt binary via Docker ``` +## MANDATORY: Verify Binary After Changes + +After ANY code change, you MUST verify the static binary actually works — never tell the user "it's fixed" without testing. Run these steps IN ORDER: + +1. `make build` — rebuild `.sls` files from `.ss` sources +2. `make static-qt` — rebuild the static Docker binary +3. `./jemacs-qt --version` — verify binary launches without exceptions + +If step 3 throws ANY exception (library not found, unbound variable, dynamic loading errors), the fix is NOT done. Common pitfalls: + +- **`library (std ...) not found`**: The Docker image has a stale jerboa `std/` tree. New modules must be added to the sync list in the `linux-static-qt-docker` Makefile target AND compiled into the WPO step in `build-binary-qt.ss`. +- **`Dynamic loading not supported`**: Any `load-shared-object` call must be guarded with the `JEMACS_STATIC` env var check (the binary sets `JEMACS_STATIC=1`). +- **`final:` or other unsupported keywords**: jerbuild doesn't support all Gerbil `defstruct` keywords — remove them. +- **Dependencies not in gerbil-qt**: This project uses `~/mine/chez-qt`, NOT `~/mine/gerbil-qt`. The `CHEZ_QT_SHIM_DIR` must point to `.` (local project root) for runtime, and `vendor/` for the build header. + +Do NOT rely on `make run-qt` (interpreted mode) as proof the binary works — the static binary has different constraints (no `load-shared-object`, all libraries must be compiled in). + ## Test Commands ```bash --- a/Makefile +++ b/Makefile @@ -4,11 +4,11 @@ JSH = vendor/jerboa-shell/src GHERKIN = $(HOME)/mine/gherkin/src LIBDIRS = --libdirs lib:$(JERBOA)/lib:$(JSH):$(GHERKIN):$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla/src:$(HOME)/mine/chez-qt JERBUILD = $(SCHEME) --libdirs $(JERBOA)/lib --script $(JERBOA)/jerbuild.ss -export LD_LIBRARY_PATH := .:$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla:$(HOME)/mine/chez-qt:$(HOME)/mine/gerbil-qt/vendor:vendor/jerboa-shell:$(LD_LIBRARY_PATH) +export LD_LIBRARY_PATH := .:$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla:$(HOME)/mine/chez-qt:vendor/jerboa-shell:$(LD_LIBRARY_PATH) export CHEZ_SCINTILLA_LIB := $(HOME)/mine/chez-scintilla export CHEZ_PCRE2_LIB := $(HOME)/mine/chez-pcre2 export CHEZ_QT_LIB := $(HOME)/mine/chez-qt -export CHEZ_QT_SHIM_DIR := $(HOME)/mine/gerbil-qt/vendor +export CHEZ_QT_SHIM_DIR := . .PHONY: all 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 \ @@ -37,7 +37,7 @@ vterm_shim.so: support/vterm_shim.c gcc -shared -fPIC -O2 -o vterm_shim.so support/vterm_shim.c -lvterm -Wall QT_INC := $(shell qmake6 -query QT_INSTALL_HEADERS 2>/dev/null || echo /usr/include/x86_64-linux-gnu/qt6) -QT_SHIM_H := $(HOME)/mine/gerbil-qt/vendor +QT_SHIM_H := vendor libqt_shim.so: vendor/qt_shim.cpp g++ -shared -fPIC -std=c++17 -O2 \ @@ -47,8 +47,11 @@ libqt_shim.so: vendor/qt_shim.cpp -o libqt_shim.so \ -lQt6Core -lQt6Gui -lQt6Widgets -lqscintilla2_qt6 -run-qt: build repl_shim.so libqt_shim.so vterm_shim.so - $(SCHEME) $(LIBDIRS) --script qt-main.ss +qt_chez_shim.so: vendor/qt_chez_shim.c vendor/qt_shim.h + gcc -shared -fPIC -O2 -o qt_chez_shim.so vendor/qt_chez_shim.c -Ivendor -Wall + +run-qt: build repl_shim.so libqt_shim.so vterm_shim.so qt_chez_shim.so + LD_PRELOAD=./qt_chez_shim.so $(SCHEME) $(LIBDIRS) --script qt-main.ss # Qt backend build target build-qt: build @@ -289,9 +292,12 @@ build-jemacs-qt-static: check-root --compile-imported-libraries --script /src/vendor/chez-scintilla-compile-libs.ss && \ rm -f /deps/chez-scintilla/src/chez-scintilla/*.wpo && \ cp /src/vendor/jerboa-net-tcp-static.sls /deps/jerboa/lib/std/net/tcp.sls && \ + cp /src/vendor/jerboa-net-uri.sls /deps/jerboa/lib/std/net/uri.sls && \ rm -f /deps/jerboa/lib/std/net/*.wpo && \ JEMACS_STATIC=1 /opt/chez/bin/scheme --libdirs /deps/jerboa/lib \ --compile-imported-libraries --script /src/vendor/jerboa-compile-tcp.ss && \ + /opt/chez/bin/scheme --libdirs /deps/jerboa/lib \ + --compile-imported-libraries --script /src/vendor/jerboa-compile-uri.ss && \ rm -f /deps/jerboa/lib/std/net/*.wpo && \ cp /src/vendor/jerboa-repl-static.sls /deps/jerboa/lib/std/repl.sls && \ rm -f /deps/jerboa/lib/std/repl.wpo /deps/jerboa/lib/std/repl.so && \ @@ -322,8 +328,25 @@ linux-static-qt-docker: docker run --rm \ --ulimit nofile=8192:8192 \ -v $(CURDIR):/src:z \ + -v $(JERBOA)/lib/std:/host-jerboa-std:ro \ $(DEPS_IMAGE) \ sh -c "apk add --no-cache libvterm-dev libvterm-static >/dev/null 2>&1; \ + for f in \ + misc/atom.sls misc/channel.sls misc/completion.sls misc/list.sls \ + misc/memo.sls misc/number.sls misc/ports.sls misc/process.sls \ + misc/rwlock.sls misc/shuffle.sls misc/string.sls \ + net/request.sls net/uri.sls \ + os/fdio.sls os/signal.sls \ + text/base64.sls text/diff.sls text/glob.sls text/hex.sls text/json.sls \ + crypto/digest.sls \ + format.sls iter.sls pregexp.sls sort.sls sugar.sls \ + srfi/srfi-1.sls srfi/srfi-13.sls srfi/srfi-19.sls; do \ + if [ -f /host-jerboa-std/\$$f ]; then \ + mkdir -p /deps/jerboa/lib/std/$$(dirname \$$f); \ + cp /host-jerboa-std/\$$f /deps/jerboa/lib/std/\$$f; \ + rm -f /deps/jerboa/lib/std/\$${f%.sls}.so /deps/jerboa/lib/std/\$${f%.sls}.wpo; \ + fi; \ + done; \ chmod 755 /root && \ chown -R $(UID):$(GID) /opt/ /deps && \ mkdir -p /tmp/jemacs-build && chown $(UID):$(GID) /tmp/jemacs-build && \ --- a/build-binary-qt.ss +++ b/build-binary-qt.ss @@ -163,12 +163,15 @@ "std/os/path" "std/os/signal" "std/os/fdio")) - ;; Jerboa core + sugar + ;; Jerboa core + sugar + repl (map (lambda (m) (format "~a/~a.so" jerboa-dir m)) '("jerboa/core" - "std/sugar")) - ;; std/net/tcp (compiled by step 1) - (list (format "~a/std/net/tcp.so" jerboa-dir)) + "std/sugar" + "std/repl")) + ;; std/net/tcp and std/net/uri (compiled by step 1) + (map (lambda (m) (format "~a/~a.so" jerboa-dir m)) + '("std/net/tcp" + "std/net/uri")) ;; jerboa/repl-socket (non-blocking socket FFI for debug REPL + IPC) (list "lib/jerboa/repl-socket.so") ;; Gherkin MOP modules (WPO-missing, must be in boot file) new file mode 100644 --- /dev/null +++ b/lib/gerbil-litehtml/html.sls @@ -0,0 +1,29 @@ +;;; Stub library for gerbil-litehtml/html +;;; Provides no-op implementations when litehtml is not installed. +;;; EWW browser will report errors at runtime instead of crashing at load time. + +(library (gerbil-litehtml html) + (export html-context-create + html-container-create + html-container-set-callbacks! + html-container-set-viewport! + html-container-set-media-type! + html-container-set-media-color! + html-document-create + html-document-render! + html-document-draw! + html-document-destroy! + html-container-destroy!) + (import (chezscheme)) + + (define (html-context-create . args) #f) + (define (html-container-create . args) #f) + (define (html-container-set-callbacks! . args) (void)) + (define (html-container-set-viewport! . args) (void)) + (define (html-container-set-media-type! . args) (void)) + (define (html-container-set-media-color! . args) (void)) + (define (html-document-create . args) #f) + (define (html-document-render! . args) (void)) + (define (html-document-draw! . args) (void)) + (define (html-document-destroy! . args) (void)) + (define (html-container-destroy! . args) (void))) --- a/lib/jerboa-emacs/qt/commands-modes2.sls +++ b/lib/jerboa-emacs/qt/commands-modes2.sls @@ -69,7 +69,7 @@ getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name sort sort!) (std sugar) (chez-scintilla constants) (std sort) - (std srfi srfi-13) (std text base64) (gerbil-litehtml html) + (std srfi srfi-13) (std text base64) (jerboa-emacs qt sci-shim) (jerboa-emacs core) (jerboa-emacs async) (jerboa-emacs editor) (jerboa-emacs repl) (jerboa-emacs eshell) --- a/src/jerboa-emacs/core.ss +++ b/src/jerboa-emacs/core.ss @@ -249,7 +249,7 @@ ;;; Quit flag (C-g subprocess interruption) ;;;============================================================================ -(defstruct keyboard-quit-exception () final: #t) +(defstruct keyboard-quit-exception ()) (def *quit-flag* #f) --- a/src/jerboa-emacs/qt/commands-modes2.ss +++ b/src/jerboa-emacs/qt/commands-modes2.ss @@ -9,7 +9,6 @@ :std/sort :std/srfi/13 :std/text/base64 - :gerbil-litehtml/html :jerboa-emacs/qt/sci-shim :jerboa-emacs/core :jerboa-emacs/async --- a/src/jerboa-emacs/vtscreen.ss +++ b/src/jerboa-emacs/vtscreen.ss @@ -47,9 +47,13 @@ ;;;============================================================================ (def vterm-shim-loaded - (let ((dir (or (getenv "JERBOA_EMACS_SUPPORT") - (string-append (or (getenv "HOME") ".") "/mine/jerboa-emacs")))) - (load-shared-object (string-append dir "/vterm_shim.so")))) + (let ((static? (let ((v (getenv "JEMACS_STATIC"))) + (and v (not (string=? v "")) (not (string=? v "0")))))) + (if static? + #f ; symbols already linked into the binary + (let ((dir (or (getenv "JERBOA_EMACS_SUPPORT") + (string-append (or (getenv "HOME") ".") "/mine/jerboa-emacs")))) + (load-shared-object (string-append dir "/vterm_shim.so")))))) ;; Core lifecycle (def ffi-jvt-new (foreign-procedure "jvt_new" (int int) void*)) new file mode 100644 --- /dev/null +++ b/vendor/jerboa-compile-uri.ss @@ -0,0 +1,2 @@ +;;; jerboa-compile-uri.ss — Compile std/net/uri for static build +(import (std net uri)) new file mode 100644 --- /dev/null +++ b/vendor/jerboa-net-uri.sls @@ -0,0 +1,233 @@ +#!chezscheme +;;; :std/net/uri -- URI parsing and encoding + +(library (std net uri) + (export uri-parse + uri-scheme uri-host uri-port uri-path + uri-query uri-fragment uri-userinfo + uri-encode uri-decode + uri->string + query-string->alist + alist->query-string) + (import (chezscheme)) + + ;; URI record + (define-record-type uri + (fields scheme userinfo host port path query fragment) + (protocol + (lambda (new) + (lambda (scheme userinfo host port path query fragment) + (new scheme userinfo host port path query fragment))))) + + ;; Parse a URI string into a uri record. + ;; Format: scheme://userinfo@host:port/path?query#fragment + (define (uri-parse str) + (let* ([len (string-length str)] + [pos 0] + [scheme #f] [userinfo #f] [host #f] + [port #f] [path ""] [query #f] [fragment #f]) + ;; helper: find char starting at i, return index or #f + (define (find-char c i) + (let lp ([j i]) + (cond [(>= j len) #f] + [(char=? (string-ref str j) c) j] + [else (lp (+ j 1))]))) + ;; helper: substring + (define (sub start end) + (substring str start end)) + + ;; Parse fragment (from end) + (let ([hash-pos (find-char #\# pos)]) + (when hash-pos + (set! fragment (sub (+ hash-pos 1) len)) + (set! len hash-pos))) + + ;; Parse query + (let ([q-pos (find-char #\? pos)]) + (when q-pos + (set! query (sub (+ q-pos 1) len)) + (set! len q-pos))) + + ;; Parse scheme + (let ([colon-pos (find-char #\: pos)]) + (when (and colon-pos + (< (+ colon-pos 2) len) + (char=? (string-ref str (+ colon-pos 1)) #\/) + (char=? (string-ref str (+ colon-pos 2)) #\/)) + (set! scheme (sub pos colon-pos)) + (set! pos (+ colon-pos 3)))) + + ;; If we had a scheme, parse authority + (when scheme + ;; Find end of authority (next / or end) + (let ([slash-pos (find-char #\/ pos)]) + (let* ([auth-end (or slash-pos len)] + [auth (sub pos auth-end)]) + ;; Parse userinfo@ + (let ([at-pos (let lp ([j 0]) + (cond [(>= j (string-length auth)) #f] + [(char=? (string-ref auth j) #\@) j] + [else (lp (+ j 1))]))]) + (let ([host-start (if at-pos + (begin + (set! userinfo (substring auth 0 at-pos)) + (+ at-pos 1)) + 0)]) + ;; Parse host:port + (let ([colon (let lp ([j host-start]) + (cond [(>= j (string-length auth)) #f] + [(char=? (string-ref auth j) #\:) j] + [else (lp (+ j 1))]))]) + (if colon + (begin + (set! host (substring auth host-start colon)) + (set! port (string->number + (substring auth (+ colon 1) + (string-length auth))))) + (set! host (substring auth host-start + (string-length auth))))))) + ;; Remaining is path + (when slash-pos + (set! path (sub slash-pos len)))))) + + ;; No scheme -- treat entire remaining as path + (unless scheme + (set! path (sub pos len))) + + (make-uri scheme userinfo host port path query fragment))) + + ;; Percent-encoding + (define (unreserved-char? c) + (or (char-alphabetic? c) + (char-numeric? c) + (memv c '(#\- #\_ #\. #\~)))) + + (define (uri-encode str) + (let ([out (open-output-string)]) + (string-for-each + (lambda (c) + (if (unreserved-char? c) + (write-char c out) + (let ([b (char->integer c)]) + (if (< b 128) + (begin + (write-char #\% out) + (let ([hex (number->string b 16)]) + (when (< b 16) (write-char #\0 out)) + (display (string-upcase hex) out))) + ;; Multi-byte: encode UTF-8 bytes + (let ([bv (string->utf8 (string c))]) + (let lp ([i 0]) + (when (< i (bytevector-length bv)) + (write-char #\% out) + (let ([hex (number->string (bytevector-u8-ref bv i) 16)]) + (when (< (bytevector-u8-ref bv i) 16) + (write-char #\0 out)) + (display (string-upcase hex) out)) + (lp (+ i 1))))))))) + str) + (get-output-string out))) + + (define (hex-digit? c) + (or (char-numeric? c) + (memv (char-downcase c) '(#\a #\b #\c #\d #\e #\f)))) + + (define (hex-value c) + (let ([n (char->integer (char-downcase c))]) + (if (>= n (char->integer #\a)) + (+ 10 (- n (char->integer #\a))) + (- n (char->integer #\0))))) + + (define (uri-decode str) + (let ([out (open-output-string)] + [len (string-length str)]) + (let lp ([i 0]) + (when (< i len) + (let ([c (string-ref str i)]) + (cond + [(and (char=? c #\%) + (< (+ i 2) len) + (hex-digit? (string-ref str (+ i 1))) + (hex-digit? (string-ref str (+ i 2)))) + (write-char + (integer->char + (+ (* 16 (hex-value (string-ref str (+ i 1)))) + (hex-value (string-ref str (+ i 2))))) + out) + (lp (+ i 3))] + [(char=? c #\+) + (write-char #\space out) + (lp (+ i 1))] + [else + (write-char c out) + (lp (+ i 1))])))) + (get-output-string out))) + + ;; Reconstruct URI string from record + (define (uri->string u) + (let ([out (open-output-string)]) + (when (uri-scheme u) + (display (uri-scheme u) out) + (display "://" out)) + (when (uri-userinfo u) + (display (uri-userinfo u) out) + (display "@" out)) + (when (uri-host u) + (display (uri-host u) out)) + (when (uri-port u) + (display ":" out) + (display (uri-port u) out)) + (display (uri-path u) out) + (when (uri-query u) + (display "?" out) + (display (uri-query u) out)) + (when (uri-fragment u) + (display "#" out) + (display (uri-fragment u) out)) + (get-output-string out))) + + ;; Query string parsing + (define (query-string->alist qs) + (if (or (not qs) (string=? qs "")) + '() + (let lp ([pairs (string-split qs #\&)] + [acc '()]) + (if (null? pairs) + (reverse acc) + (let* ([pair (car pairs)] + [eq-pos (let scan ([j 0]) + (cond [(>= j (string-length pair)) #f] + [(char=? (string-ref pair j) #\=) j] + [else (scan (+ j 1))]))]) + (lp (cdr pairs) + (cons (if eq-pos + (cons (uri-decode (substring pair 0 eq-pos)) + (uri-decode (substring pair (+ eq-pos 1) + (string-length pair)))) + (cons (uri-decode pair) "")) + acc))))))) + + ;; Helper: split string by separator character + (define (string-split str sep) + (let ([len (string-length str)]) + (let lp ([i 0] [start 0] [acc '()]) + (cond + [(>= i len) + (reverse (cons (substring str start len) acc))] + [(char=? (string-ref str i) sep) + (lp (+ i 1) (+ i 1) + (cons (substring str start i) acc))] + [else (lp (+ i 1) start acc)])))) + + (define (alist->query-string alist) + (let ([out (open-output-string)]) + (let lp ([pairs alist] [first? #t]) + (unless (null? pairs) + (unless first? (display "&" out)) + (display (uri-encode (car (car pairs))) out) + (display "=" out) + (display (uri-encode (cdr (car pairs))) out) + (lp (cdr pairs) #f))) + (get-output-string out))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/vendor/qt_chez_shim.c @@ -0,0 +1,457 @@ +/* qt_chez_shim.c — Deferred callback bridge for Chez Scheme + Qt SMP + * + * PROBLEM: Chez SMP GC uses stop-the-world rendezvous. When + * Sactivate_thread() registers the Qt event-loop pthread as a Chez VP, + * the Qt thread never participates in GC safe-point protocol (it's in + * poll()), causing permanent GC deadlock. + * + * SOLUTION: Qt callbacks never call Sactivate_thread(). Instead they + * push events to a lock-free SPSC ring buffer. The primordial Chez + * thread drains the buffer via chez_qt_drain_pending_callbacks(), + * calling the Scheme trampolines on a proper Chez thread. + * + * The ring buffer is single-producer (Qt event-loop thread) and + * single-consumer (primordial Chez thread via master timer). + */ + +#include "qt_shim.h" +#include <stddef.h> +#include <string.h> +#include <stdlib.h> +#include <stdatomic.h> + +/* ---- Stored callback function pointers (set from Chez at init time) ---- */ +static qt_callback_void chez_void_callback = NULL; +static qt_callback_string chez_string_callback = NULL; +static qt_callback_int chez_int_callback = NULL; +static qt_callback_bool chez_bool_callback = NULL; + +/* ==== Deferred Callback Queue (SPSC ring buffer) ==== */ + +#define CB_QUEUE_SIZE 8192 /* must be power of 2 */ +#define CB_STRING_MAX 1024 + +enum cb_type { CB_VOID = 0, CB_STRING = 1, CB_INT = 2, CB_BOOL = 3 }; + +struct cb_entry { + enum cb_type type; + long id; + int int_value; + char str_value[CB_STRING_MAX]; +}; + +static struct cb_entry cb_queue[CB_QUEUE_SIZE]; +static _Atomic unsigned int cb_head = 0; /* written by producer (Qt thread) */ +static _Atomic unsigned int cb_tail = 0; /* written by consumer (primordial) */ + +static inline void cb_push_void(long id) { + unsigned int h = atomic_load_explicit(&cb_head, memory_order_relaxed); + unsigned int next = (h + 1) & (CB_QUEUE_SIZE - 1); + if (next == atomic_load_explicit(&cb_tail, memory_order_acquire)) + return; /* queue full — drop event */ + cb_queue[h].type = CB_VOID; + cb_queue[h].id = id; + atomic_store_explicit(&cb_head, next, memory_order_release); +} + +static inline void cb_push_string(long id, const char* s) { + unsigned int h = atomic_load_explicit(&cb_head, memory_order_relaxed); + unsigned int next = (h + 1) & (CB_QUEUE_SIZE - 1); + if (next == atomic_load_explicit(&cb_tail, memory_order_acquire)) + return; + cb_queue[h].type = CB_STRING; + cb_queue[h].id = id; + if (s) { + strncpy(cb_queue[h].str_value, s, CB_STRING_MAX - 1); + cb_queue[h].str_value[CB_STRING_MAX - 1] = '\0'; + } else { + cb_queue[h].str_value[0] = '\0'; + } + atomic_store_explicit(&cb_head, next, memory_order_release); +} + +static inline void cb_push_int(long id, int v) { + unsigned int h = atomic_load_explicit(&cb_head, memory_order_relaxed); + unsigned int next = (h + 1) & (CB_QUEUE_SIZE - 1); + if (next == atomic_load_explicit(&cb_tail, memory_order_acquire)) + return; + cb_queue[h].type = CB_INT; + cb_queue[h].id = id; + cb_queue[h].int_value = v; + atomic_store_explicit(&cb_head, next, memory_order_release); +} + +static inline void cb_push_bool(long id, int v) { + unsigned int h = atomic_load_explicit(&cb_head, memory_order_relaxed); + unsigned int next = (h + 1) & (CB_QUEUE_SIZE - 1); + if (next == atomic_load_explicit(&cb_tail, memory_order_acquire)) + return; + cb_queue[h].type = CB_BOOL; + cb_queue[h].id = id; + cb_queue[h].int_value = v; + atomic_store_explicit(&cb_head, next, memory_order_release); +} + +/* ---- Deferred wrappers: push to queue instead of calling Scheme ---- */ +static void deferred_void_callback(long id) { cb_push_void(id); } +static void deferred_string_callback(long id, const char* s) { cb_push_string(id, s); } +static void deferred_int_callback(long id, int v) { cb_push_int(id, v); } +static void deferred_bool_callback(long id, int v) { cb_push_bool(id, v); } + +/* ---- Drain function: called from primordial Chez thread ---- */ +void chez_qt_drain_pending_callbacks(void) { + unsigned int t = atomic_load_explicit(&cb_tail, memory_order_relaxed); + unsigned int h = atomic_load_explicit(&cb_head, memory_order_acquire); + while (t != h) { + struct cb_entry *e = &cb_queue[t]; + switch (e->type) { + case CB_VOID: + if (chez_void_callback) chez_void_callback(e->id); + break; + case CB_STRING: + if (chez_string_callback) chez_string_callback(e->id, e->str_value); + break; + case CB_INT: + if (chez_int_callback) chez_int_callback(e->id, e->int_value); + break; + case CB_BOOL: + if (chez_bool_callback) chez_bool_callback(e->id, e->int_value); + break; + } + t = (t + 1) & (CB_QUEUE_SIZE - 1); + atomic_store_explicit(&cb_tail, t, memory_order_release); + /* re-read head in case more events arrived */ + h = atomic_load_explicit(&cb_head, memory_order_acquire); + } +} + +/* ---- Registration functions (called once from Chez at library load) ---- */ +void chez_qt_set_void_callback(qt_callback_void cb) { chez_void_callback = cb; } +void chez_qt_set_string_callback(qt_callback_string cb) { chez_string_callback = cb; } +void chez_qt_set_int_callback(qt_callback_int cb) { chez_int_callback = cb; } +void chez_qt_set_bool_callback(qt_callback_bool cb) { chez_bool_callback = cb; } + +/* ---- Application lifecycle ---- */ +void* chez_qt_application_create(void) { + return qt_application_create(0, NULL); +} + +/* ---- Signal connection wrappers ---- */ +/* Each wrapper inserts the deferred callback as the trampoline. + * The Qt thread only writes to the ring buffer — never calls Scheme. */ + +/* Push Button */ +void chez_qt_push_button_on_clicked(void* b, long callback_id) { + if (chez_void_callback) + qt_push_button_on_clicked(b, deferred_void_callback, callback_id); +} + +/* Line Edit */ +void chez_qt_line_edit_on_text_changed(void* e, long callback_id) { + if (chez_string_callback) + qt_line_edit_on_text_changed(e, deferred_string_callback, callback_id); +} +void chez_qt_line_edit_on_return_pressed(void* e, long callback_id) { + if (chez_void_callback) + qt_line_edit_on_return_pressed(e, deferred_void_callback, callback_id); +} + +/* Check Box */ +void chez_qt_check_box_on_toggled(void* c, long callback_id) { + if (chez_bool_callback) + qt_check_box_on_toggled(c, deferred_bool_callback, callback_id); +} + +/* Combo Box */ +void chez_qt_combo_box_on_current_index_changed(void* c, long callback_id) { + if (chez_int_callback) + qt_combo_box_on_current_index_changed(c, deferred_int_callback, callback_id); +} + +/* Text Edit */ +void chez_qt_text_edit_on_text_changed(void* e, long callback_id) { + if (chez_void_callback) + qt_text_edit_on_text_changed(e, deferred_void_callback, callback_id); +} + +/* Spin Box */ +void chez_qt_spin_box_on_value_changed(void* s, long callback_id) { + if (chez_int_callback) + qt_spin_box_on_value_changed(s, deferred_int_callback, callback_id); +} + +/* Action */ +void chez_qt_action_on_triggered(void* a, long callback_id) { + if (chez_void_callback) + qt_action_on_triggered(a, deferred_void_callback, callback_id); +} +void chez_qt_action_on_toggled(void* a, long callback_id) { + if (chez_bool_callback) + qt_action_on_toggled(a, deferred_bool_callback, callback_id); +} + +/* List Widget */ +void chez_qt_list_widget_on_current_row_changed(void* l, long callback_id) { + if (chez_int_callback) + qt_list_widget_on_current_row_changed(l, deferred_int_callback, callback_id); +} +void chez_qt_list_widget_on_item_double_clicked(void* l, long callback_id) { + if (chez_int_callback) + qt_list_widget_on_item_double_clicked(l, deferred_int_callback, callback_id); +} + +/* Table Widget */ +void chez_qt_table_widget_on_cell_clicked(void* t, long callback_id) { + if (chez_void_callback) + qt_table_widget_on_cell_clicked(t, deferred_void_callback, callback_id); +} + +/* Tab Widget */ +void chez_qt_tab_widget_on_current_changed(void* t, long callback_id) { + if (chez_int_callback) + qt_tab_widget_on_current_changed(t, deferred_int_callback, callback_id); +} + +/* Slider */ +void chez_qt_slider_on_value_changed(void* s, long callback_id) { + if (chez_int_callback) + qt_slider_on_value_changed(s, deferred_int_callback, callback_id); +} + +/* Timer */ +void chez_qt_timer_on_timeout(void* t, long callback_id) { + if (chez_void_callback) + qt_timer_on_timeout(t, deferred_void_callback, callback_id); +} +void chez_qt_timer_single_shot(int msec, long callback_id) { + if (chez_void_callback) + qt_timer_single_shot(msec, deferred_void_callback, callback_id); +} + +/* Clipboard */ +void chez_qt_clipboard_on_changed(void* app, long callback_id) { + if (chez_void_callback) + qt_clipboard_on_changed(app, deferred_void_callback, callback_id); +} + +/* Tree Widget */ +void chez_qt_tree_widget_on_current_item_changed(void* t, long callback_id) { + if (chez_void_callback) + qt_tree_widget_on_current_item_changed(t, deferred_void_callback, callback_id); +} +void chez_qt_tree_widget_on_item_double_clicked(void* t, long callback_id) { + if (chez_void_callback) + qt_tree_widget_on_item_double_clicked(t, deferred_void_callback, callback_id); +} +void chez_qt_tree_widget_on_item_expanded(void* t, long callback_id) { + if (chez_void_callback) + qt_tree_widget_on_item_expanded(t, deferred_void_callback, callback_id); +} +void chez_qt_tree_widget_on_item_collapsed(void* t, long callback_id) { + if (chez_void_callback) + qt_tree_widget_on_item_collapsed(t, deferred_void_callback, callback_id); +} + +/* Keyboard Events */ +void chez_qt_install_key_handler(void* w, long callback_id) { + if (chez_void_callback) + qt_widget_install_key_handler(w, deferred_void_callback, callback_id); +} +void chez_qt_install_key_handler_consuming(void* w, long callback_id) { + if (chez_void_callback) + qt_widget_install_key_handler_consuming(w, deferred_void_callback, callback_id); +} + +/* Radio Button */ +void chez_qt_radio_button_on_toggled(void* r, long callback_id) { + if (chez_bool_callback) + qt_radio_button_on_toggled(r, deferred_bool_callback, callback_id); +} + +/* Button Group */ +void chez_qt_button_group_on_clicked(void* g, long callback_id) { + if (chez_int_callback) + qt_button_group_on_id_clicked(g, deferred_int_callback, callback_id); +} + +/* Group Box */ +void chez_qt_group_box_on_toggled(void* g, long callback_id) { + if (chez_bool_callback) + qt_group_box_on_toggled(g, deferred_bool_callback, callback_id); +} + +/* Stacked Widget */ +void chez_qt_stacked_widget_on_current_changed(void* s, long callback_id) { + if (chez_int_callback) + qt_stacked_widget_on_current_changed(s, deferred_int_callback, callback_id); +} + +/* System Tray */ +void chez_qt_system_tray_icon_on_activated(void* t, long callback_id) { + if (chez_int_callback) + qt_system_tray_icon_on_activated(t, deferred_int_callback, callback_id); +} + +/* Paint Widget */ +void chez_qt_paint_widget_on_paint(void* w, long callback_id) { + if (chez_void_callback) + qt_paint_widget_on_paint(w, deferred_void_callback, callback_id); +} + +/* Completer */ +void chez_qt_completer_on_activated(void* c, long callback_id) { + if (chez_string_callback) + qt_completer_on_activated(c, deferred_string_callback, callback_id); +} + +/* Double Spin Box — value comes as string */ +void chez_qt_double_spin_box_on_value_changed(void* s, long callback_id) { + if (chez_string_callback) + qt_double_spin_box_on_value_changed(s, deferred_string_callback, callback_id); +} + +/* Date Edit — date comes as string */ +void chez_qt_date_edit_on_date_changed(void* d, long callback_id) { + if (chez_string_callback) + qt_date_edit_on_date_changed(d, deferred_string_callback, callback_id); +} + +/* Time Edit — time comes as string */ +void chez_qt_time_edit_on_time_changed(void* t, long callback_id) { + if (chez_string_callback) + qt_time_edit_on_time_changed(t, deferred_string_callback, callback_id); +} + +/* Progress Dialog */ +void chez_qt_progress_dialog_on_canceled(void* d, long callback_id) { + if (chez_void_callback) + qt_progress_dialog_on_canceled(d, deferred_void_callback, callback_id); +} + +/* Shortcut */ +void chez_qt_shortcut_on_activated(void* s, long callback_id) { + if (chez_void_callback) + qt_shortcut_on_activated(s, deferred_void_callback, callback_id); +} + +/* Text Browser */ +void chez_qt_text_browser_on_anchor_clicked(void* b, long callback_id) { + if (chez_string_callback) + qt_text_browser_on_anchor_clicked(b, deferred_string_callback, callback_id); +} + +/* Button Box */ +void chez_qt_button_box_on_accepted(void* b, long callback_id) { + if (chez_void_callback) + qt_button_box_on_accepted(b, deferred_void_callback, callback_id); +} +void chez_qt_button_box_on_rejected(void* b, long callback_id) { + if (chez_void_callback) + qt_button_box_on_rejected(b, deferred_void_callback, callback_id); +} +void chez_qt_button_box_on_clicked(void* b, long callback_id) { + if (chez_void_callback) + qt_button_box_on_clicked(b, deferred_void_callback, callback_id); +} + +/* Calendar */ +void chez_qt_calendar_on_selection_changed(void* c, long callback_id) { + if (chez_void_callback) + qt_calendar_on_selection_changed(c, deferred_void_callback, callback_id); +} +void chez_qt_calendar_on_clicked(void* c, long callback_id) { + if (chez_string_callback) + qt_calendar_on_clicked(c, deferred_string_callback, callback_id); +} + +/* View signals */ +void chez_qt_view_on_clicked(void* v, long callback_id) { + if (chez_void_callback) + qt_view_on_clicked(v, deferred_void_callback, callback_id); +} +void chez_qt_view_on_double_clicked(void* v, long callback_id) { + if (chez_void_callback) + qt_view_on_double_clicked(v, deferred_void_callback, callback_id); +} +void chez_qt_view_on_activated(void* v, long callback_id) { + if (chez_void_callback) + qt_view_on_activated(v, deferred_void_callback, callback_id); +} +void chez_qt_view_on_selection_changed(void* v, long callback_id) { + if (chez_void_callback) + qt_view_on_selection_changed(v, deferred_void_callback, callback_id); +} + +/* Plain Text Edit */ +void chez_qt_plain_text_edit_on_text_changed(void* e, long callback_id) { + if (chez_void_callback) + qt_plain_text_edit_on_text_changed(e, deferred_void_callback, callback_id); +} + +/* Tool Button */ +void chez_qt_tool_button_on_clicked(void* b, long callback_id) { + if (chez_void_callback) + qt_tool_button_on_clicked(b, deferred_void_callback, callback_id); +} + +/* Process */ +void chez_qt_process_on_finished(void* p, long callback_id) { + if (chez_int_callback) + qt_process_on_finished(p, deferred_int_callback, callback_id); +} +void chez_qt_process_on_ready_read(void* p, long callback_id) { + if (chez_void_callback) + qt_process_on_ready_read(p, deferred_void_callback, callback_id); +} + +/* Wizard */ +void chez_qt_wizard_on_current_changed(void* w, long callback_id) { + if (chez_int_callback) + qt_wizard_on_current_changed(w, deferred_int_callback, callback_id); +} + +/* MDI Area */ +void chez_qt_mdi_area_on_sub_window_activated(void* a, long callback_id) { + if (chez_void_callback) + qt_mdi_area_on_sub_window_activated(a, deferred_void_callback, callback_id); +} + +/* Dial */ +void chez_qt_dial_on_value_changed(void* d, long callback_id) { + if (chez_int_callback) + qt_dial_on_value_changed(d, deferred_int_callback, callback_id); +} + +/* Tool Box */ +void chez_qt_tool_box_on_current_changed(void* t, long callback_id) { + if (chez_int_callback) + qt_tool_box_on_current_changed(t, deferred_int_callback, callback_id); +} + +/* QScintilla (conditional) */ +#ifdef QT_SCINTILLA_AVAILABLE +void chez_qt_scintilla_on_text_changed(void* s, long callback_id) { + if (chez_void_callback) + qt_scintilla_on_text_changed(s, deferred_void_callback, callback_id); +} +void chez_qt_scintilla_on_char_added(void* s, long callback_id) { + if (chez_int_callback) + qt_scintilla_on_char_added(s, deferred_int_callback, callback_id); +} +void chez_qt_scintilla_on_save_point_reached(void* s, long callback_id) { + if (chez_void_callback) + qt_scintilla_on_save_point_reached(s, deferred_void_callback, callback_id); +} +void chez_qt_scintilla_on_save_point_left(void* s, long callback_id) { + if (chez_void_callback) + qt_scintilla_on_save_point_left(s, deferred_void_callback, callback_id); +} +void chez_qt_scintilla_on_margin_clicked(void* s, long callback_id) { + if (chez_int_callback) + qt_scintilla_on_margin_clicked(s, deferred_int_callback, callback_id); +} +void chez_qt_scintilla_on_modified(void* s, long callback_id) { + if (chez_void_callback) + qt_scintilla_on_modified(s, (qt_callback_int)deferred_void_callback, callback_id); +} +#endif new file mode 100644 --- /dev/null +++ b/vendor/qt_shim.h @@ -0,0 +1,1605 @@ +#ifndef QT_SHIM_H +#define QT_SHIM_H + +#ifdef __cplusplus +extern "C" { +#endif + +/* --- Opaque handle types --- */ +typedef void* qt_application_t; +typedef void* qt_widget_t; +typedef void* qt_main_window_t; +typedef void* qt_layout_t; +typedef void* qt_label_t; +typedef void* qt_push_button_t; + +/* --- Callback signatures --- */ +typedef void (*qt_callback_void)(long callback_id); +typedef void (*qt_callback_string)(long callback_id, const char* value); +typedef void (*qt_callback_int)(long callback_id, int value); +typedef void (*qt_callback_bool)(long callback_id, int value); + +/* --- Application lifecycle --- */ +qt_application_t qt_application_create(int argc, char** argv); +int qt_application_exec(qt_application_t app); +void qt_application_quit(qt_application_t app); +void qt_application_process_events(qt_application_t app); +void qt_application_destroy(qt_application_t app); + +/* --- Widget base (applies to all widget types) --- */ +qt_widget_t qt_widget_create(qt_widget_t parent); +void qt_widget_show(qt_widget_t w); +void qt_widget_hide(qt_widget_t w); +void qt_widget_close(qt_widget_t w); +void qt_widget_set_enabled(qt_widget_t w, int enabled); +int qt_widget_is_enabled(qt_widget_t w); +void qt_widget_set_visible(qt_widget_t w, int visible); +int qt_widget_is_visible(qt_widget_t w); +void qt_widget_set_fixed_size(qt_widget_t w, int width, int height); +void qt_widget_set_minimum_size(qt_widget_t w, int width, int height); +void qt_widget_set_maximum_size(qt_widget_t w, int width, int height); +void qt_widget_set_minimum_width(qt_widget_t w, int width); +void qt_widget_set_minimum_height(qt_widget_t w, int height); +void qt_widget_set_maximum_width(qt_widget_t w, int width); +void qt_widget_set_maximum_height(qt_widget_t w, int height); +void qt_widget_set_cursor(qt_widget_t w, int shape); +void qt_widget_unset_cursor(qt_widget_t w); +void qt_widget_resize(qt_widget_t w, int width, int height); +void qt_widget_set_style_sheet(qt_widget_t w, const char* css); +void qt_widget_set_tooltip(qt_widget_t w, const char* text); +void qt_widget_set_font_size(qt_widget_t w, int size); +void qt_widget_destroy(qt_widget_t w); + +/* --- Main Window --- */ +qt_main_window_t qt_main_window_create(qt_widget_t parent); +void qt_main_window_set_title(qt_main_window_t w, const char* title); +void qt_main_window_set_central_widget(qt_main_window_t w, qt_widget_t child); + +/* --- Layouts --- */ +qt_layout_t qt_vbox_layout_create(qt_widget_t parent); +qt_layout_t qt_hbox_layout_create(qt_widget_t parent); +void qt_layout_add_widget(qt_layout_t layout, qt_widget_t widget); +void qt_layout_add_stretch(qt_layout_t layout, int stretch); +void qt_layout_set_spacing(qt_layout_t layout, int spacing); +void qt_layout_set_margins(qt_layout_t layout, int left, int top, + int right, int bottom); + +/* --- Labels --- */ +qt_label_t qt_label_create(const char* text, qt_widget_t parent); +void qt_label_set_text(qt_label_t l, const char* text); +const char* qt_label_text(qt_label_t l); +void qt_label_set_alignment(qt_label_t l, int alignment); +void qt_label_set_word_wrap(qt_label_t l, int wrap); + +/* --- Push Button --- */ +qt_push_button_t qt_push_button_create(const char* text, qt_widget_t parent); +void qt_push_button_set_text(qt_push_button_t b, const char* text); +const char* qt_push_button_text(qt_push_button_t b); +void qt_push_button_on_clicked(qt_push_button_t b, + qt_callback_void callback, + long callback_id); + +/* ========== Phase 2 widgets ========== */ + +typedef void* qt_line_edit_t; +typedef void* qt_check_box_t; +typedef void* qt_combo_box_t; +typedef void* qt_text_edit_t; +typedef void* qt_spin_box_t; +typedef void* qt_dialog_t; + +/* --- Line Edit --- */ +qt_line_edit_t qt_line_edit_create(qt_widget_t parent); +void qt_line_edit_set_text(qt_line_edit_t e, const char* text); +const char* qt_line_edit_text(qt_line_edit_t e); +void qt_line_edit_set_placeholder(qt_line_edit_t e, const char* text);