updates
ober
3600a6b2e7b96c6ef6a187df844ce8949bcf1f13
--- a/Makefile +++ b/Makefile @@ -1,6 +1,7 @@ -# jerbuild bundles Chez Scheme + the jerboa stdlib under ~/.cache/jerbuild/, -# so building jerboa-signal needs only `jerbuild` + a C compiler — no jerboa -# source checkout and no separately-built Chez. +# jerbuild bundles Chez Scheme, the jerboa stdlib, and the jerboa-native-rs +# source under ~/.cache/jerbuild/, so building jerboa-signal needs no jerboa +# source checkout and no separately-built Chez. Cargo is used to build the +# bundled native archive when it is not already present. JERBOA_VERSION ?= v0.2.0 JERBOA_TOOL_DIR ?= $(CURDIR)/.jerboa/bin JERBUILD ?= $(shell if [ -x ./jerbuild ] && [ -x ./jerboa ]; then \ @@ -18,7 +19,8 @@ JH = $(shell "$(JERBUILD)" --jerboa-home 2>/dev/null) JSQLITE_SRC ?= $(CURDIR)/../jsqlite/src LIBDIRS = --libdirs $(CURDIR):$(JSQLITE_SRC):$(JH)/lib -JERBOA_NATIVE_A ?= $(JH)/jerboa-native-rs/target/release/libjerboa_native.a +DEFAULT_JERBOA_NATIVE_A = $(JH)/jerboa-native-rs/target/release/libjerboa_native.a +JERBOA_NATIVE_A ?= $(DEFAULT_JERBOA_NATIVE_A) export JERBOA_NATIVE_A JEXEC = $(JERBUILD) exec $(LIBDIRS) BIN := jerboa-signal @@ -34,13 +36,13 @@ TUI_SHIM := $(TUI_SHIM_DIR)/signal_tui_shim.$(TUI_SHIM_EXT) LOG_SHIM := signal_log_shim.$(TUI_SHIM_EXT) SQLCIPHER_PREFIX := $(shell brew --prefix sqlcipher 2>/dev/null) -.PHONY: all build binary run run-tui test install install-log-shim clean help vendor-deps tui-shim log-shim ensure-jerboa-tools +.PHONY: all build binary run run-tui test install install-log-shim clean help vendor-deps tui-shim log-shim ensure-jerboa-tools ensure-jerboa-native .DEFAULT_GOAL := help all: binary # Standalone native binary via .jerbuild (entry signal/main.ss -> jerboa-signal). -binary: ensure-jerboa-tools +binary: ensure-jerboa-native $(JERBUILD) build build: binary @@ -100,6 +102,28 @@ ensure-jerboa-tools: exit 1; \ } +ensure-jerboa-native: ensure-jerboa-tools + @if [ ! -f "$(JERBOA_NATIVE_A)" ]; then \ + if [ "$(JERBOA_NATIVE_A)" != "$(DEFAULT_JERBOA_NATIVE_A)" ]; then \ + echo "ERROR: JERBOA_NATIVE_A is set but missing: $(JERBOA_NATIVE_A)"; \ + exit 1; \ + fi; \ + if [ ! -f "$(JH)/jerboa-native-rs/Cargo.toml" ]; then \ + echo "ERROR: bundled jerboa-native-rs source not found under $(JH)"; \ + exit 1; \ + fi; \ + command -v cargo >/dev/null 2>&1 || { \ + echo "ERROR: cargo is required to build $(JERBOA_NATIVE_A)"; \ + exit 1; \ + }; \ + echo "=== Building Jerboa native archive: $(JERBOA_NATIVE_A) ==="; \ + cargo build --release --manifest-path "$(JH)/jerboa-native-rs/Cargo.toml"; \ + fi + @test -f "$(JERBOA_NATIVE_A)" || { \ + echo "ERROR: missing Jerboa native archive: $(JERBOA_NATIVE_A)"; \ + exit 1; \ + } + tui-shim: vendor/termbox2 @test -f $(TUI_SHIM) || \ cc -shared -fPIC -DTB_OPT_ATTR_W=32 \ --- a/signal/tui/ffi.ss +++ b/signal/tui/ffi.ss @@ -75,12 +75,20 @@ (defrule (define-tb name c-name arg-types ret-type) (def name - (lambda args - (if (and (ensure-shim-loaded!) (foreign-entry? c-name)) - (apply (foreign-procedure c-name arg-types ret-type) args) - (error 'tui-ffi - "termbox shim not loaded; run `make tui-shim`" - c-name))))) + (let ([proc-box (box #f)]) + (lambda args + (let ([proc + (or (unbox proc-box) + (and (ensure-shim-loaded!) + (foreign-entry? c-name) + (let ([proc (foreign-procedure c-name arg-types ret-type)]) + (set-box! proc-box proc) + proc)))]) + (if proc + (apply proc args) + (error 'tui-ffi + "termbox shim not loaded; run `make tui-shim`" + c-name))))))) (define-tb c-tb-init "signal_tb_init" () int) (define-tb c-tb-shutdown "signal_tb_shutdown" () void) @@ -101,13 +109,23 @@ (define-tb c-tb-poll "signal_tb_poll_event" () int) (def c-tb-peek - (lambda args - (if (and (ensure-shim-loaded!) (foreign-entry? "signal_tb_peek_event")) - (apply (foreign-procedure __collect_safe "signal_tb_peek_event" (int) int) - args) - (error 'tui-ffi - "termbox shim not loaded; run `make tui-shim`" - "signal_tb_peek_event")))) + (let ([proc-box (box #f)]) + (lambda args + (let ([proc + (or (unbox proc-box) + (and (ensure-shim-loaded!) + (foreign-entry? "signal_tb_peek_event") + (let ([proc (foreign-procedure __collect_safe + "signal_tb_peek_event" + (int) + int)]) + (set-box! proc-box proc) + proc)))]) + (if proc + (apply proc args) + (error 'tui-ffi + "termbox shim not loaded; run `make tui-shim`" + "signal_tb_peek_event")))))) (define-tb c-tb-ev-type "signal_tb_event_type" () int) (define-tb c-tb-ev-mod "signal_tb_event_mod" () int) --- a/signal/tui/main.ss +++ b/signal/tui/main.ss @@ -179,64 +179,83 @@ (string=? (substring id 0 plen) prefix) (substring id plen (string-length id))))) + (def *idle-poll-ms* 250) + (def (event-loop state actor) - (let loop () - (handle-actor-events! state actor) - (draw! state) - (tb-present!) - (let ([ev (tb-peek-event 100)]) - (when ev - (handle-event! state actor ev))) - (unless (tui-state-quit? state) - (loop)))) + (let loop ([dirty? #t]) + (let* ([actor-dirty? (handle-actor-events! state actor)] + [timer-dirty? (expire-typing-indicators! state)]) + (when (or dirty? actor-dirty? timer-dirty?) + (draw! state) + (tb-present!)) + (let* ([ev (tb-peek-event *idle-poll-ms*)] + [event-dirty? (and ev (begin (handle-event! state actor ev) #t))]) + (unless (tui-state-quit? state) + (loop event-dirty?)))))) + + (def (expire-typing-indicators! state) + (let ([now (real-time)]) + (let loop ([convs (tui-state-conversations state)] [changed? #f]) + (cond + [(null? convs) changed?] + [else + (let* ([conv (car convs)] + [typing (conversation-typing conv)] + [expired? (and (pair? typing) (<= (cdr typing) now))]) + (when expired? + (conversation-typing-set! conv #f)) + (loop (cdr convs) (or changed? expired?)))])))) (def (handle-actor-events! state actor) (let ([events (actor-drain-events actor)]) - (unless (null? events) - (tui-state-event-count-set! - state - (+ (tui-state-event-count state) (length events))) - (for-each - (lambda (ev) - (cond - [(and (pair? ev) (eq? (car ev) 'notification)) - (let* ([notif (cadr ev)] - [chat-event (notification->chat-event notif)]) - (capture-notification! (tui-state-logdb state) - (tui-state-account state) - notif) - (if chat-event - (apply-chat-event! state chat-event) - (let ([line (notification->line notif)]) - (when line - (append-system-message! state line) - (tui-state-status-set! state "New Signal event received.")))) - (let ([saved (save-notification-attachments! notif)]) - (when (pair? saved) - (tui-state-status-set! - state - (string-append "Saved " - (number->string (length saved)) - (if (= (length saved) 1) " file to " - " files to ") - (download-base))))))] - [(and (pair? ev) (eq? (car ev) 'closed)) - (tui-state-status-set! - state - (string-append "signal-cli stream closed: " - (safe-display (cadr ev))))] - [(and (pair? ev) (eq? (car ev) 'error)) - (append-system-message! - state - (string-append "signal-cli error: " (safe-display (cadr ev)))) - (tui-state-status-set! state "signal-cli reported an error.")] - [(and (pair? ev) (eq? (car ev) 'stderr)) - (append-system-message! - state - (string-append "signal-cli: " (safe-display (cadr ev)))) - (tui-state-status-set! state "signal-cli reported a diagnostic.")] - [else (void)])) - events)))) + (if (null? events) + #f + (begin + (tui-state-event-count-set! + state + (+ (tui-state-event-count state) (length events))) + (for-each + (lambda (ev) + (cond + [(and (pair? ev) (eq? (car ev) 'notification)) + (let* ([notif (cadr ev)] + [chat-event (notification->chat-event notif)]) + (capture-notification! (tui-state-logdb state) + (tui-state-account state) + notif) + (if chat-event + (apply-chat-event! state chat-event) + (let ([line (notification->line notif)]) + (when line + (append-system-message! state line) + (tui-state-status-set! state "New Signal event received.")))) + (let ([saved (save-notification-attachments! notif)]) + (when (pair? saved) + (tui-state-status-set! + state + (string-append "Saved " + (number->string (length saved)) + (if (= (length saved) 1) " file to " + " files to ") + (download-base))))))] + [(and (pair? ev) (eq? (car ev) 'closed)) + (tui-state-status-set! + state + (string-append "signal-cli stream closed: " + (safe-display (cadr ev))))] + [(and (pair? ev) (eq? (car ev) 'error)) + (append-system-message! + state + (string-append "signal-cli error: " (safe-display (cadr ev)))) + (tui-state-status-set! state "signal-cli reported an error.")] + [(and (pair? ev) (eq? (car ev) 'stderr)) + (append-system-message! + state + (string-append "signal-cli: " (safe-display (cadr ev)))) + (tui-state-status-set! state "signal-cli reported a diagnostic.")] + [else (void)])) + events) + #t)))) (def (make-system-conversation lines) (make-conversation "system"