Add Signal TUI
ober
cb00ce7ffc6c0161f1987a9635252fa569eea9de
--- a/.gitignore +++ b/.gitignore @@ -11,3 +11,6 @@ signal-musl petite_boot.h scheme_boot.h program_boot.h +vendor/ +signal_tui_shim.dylib +signal_tui_shim.so --- a/Makefile +++ b/Makefile @@ -11,8 +11,16 @@ LIBDIRS := --libdirs $(CURDIR):$(JH)/lib JEXEC := $(JERBUILD) exec $(LIBDIRS) BIN := jerboa-signal BIN_DIR := $(HOME)/.local/bin +TUI_SHIM_DIR := $(CURDIR)/vendor/termbox2 +UNAME_S := $(shell uname -s) +ifeq ($(UNAME_S),Darwin) +TUI_SHIM_EXT := dylib +else +TUI_SHIM_EXT := so +endif +TUI_SHIM := $(TUI_SHIM_DIR)/signal_tui_shim.$(TUI_SHIM_EXT) -.PHONY: all build binary run test install clean help +.PHONY: all build binary run run-tui test install clean help vendor-deps tui-shim .DEFAULT_GOAL := help all: binary @@ -26,26 +34,47 @@ build: binary run: binary ./$(BIN) $(ARGS) +run-tui: binary tui-shim + ./$(BIN) tui $(ARGS) + test: binary ./$(BIN) --help >/dev/null && echo "smoke ok" install: binary mkdir -p $(BIN_DIR) install -m 0755 $(BIN) $(BIN_DIR)/$(BIN) + test ! -f signal_tui_shim.$(TUI_SHIM_EXT) || install -m 0755 signal_tui_shim.$(TUI_SHIM_EXT) $(BIN_DIR)/signal_tui_shim.$(TUI_SHIM_EXT) @echo "Installed $(BIN) to $(BIN_DIR)/$(BIN)" clean: rm -f $(BIN) + rm -f signal_tui_shim.dylib signal_tui_shim.so find signal \( -name '*.so' -o -name '*.wpo' \) -delete 2>/dev/null || true +vendor-deps: vendor/termbox2 + +vendor/termbox2: + mkdir -p vendor + git clone --depth 1 https://github.com/termbox/termbox2.git vendor/termbox2 + +tui-shim: vendor/termbox2 + @test -f $(TUI_SHIM) || \ + cc -shared -fPIC -DTB_OPT_ATTR_W=32 \ + -I$(TUI_SHIM_DIR) \ + -o $(TUI_SHIM) \ + signal/tui/signal_tui_shim.c + cp $(TUI_SHIM) signal_tui_shim.$(TUI_SHIM_EXT) + help: @echo "jerboa-signal -- Signal client over signal-cli" @echo "" @echo "Targets:" @echo " binary Build the standalone ./jerboa-signal (jerbuild + cc)" @echo " run ARGS='<args>' Run from source via 'jerbuild exec'" + @echo " run-tui Build shim and start the TUI" @echo " test Run tests" @echo " install Install ./jerboa-signal to ~/.local/bin" + @echo " tui-shim Build the termbox2 TUI shim" @echo " clean Remove build artifacts" @echo "" @echo "Prerequisite: signal-cli must be linked to your Signal account." --- a/README.md +++ b/README.md @@ -12,6 +12,7 @@ Bidirectional bridge between Signal and your shell: ``` jerboa-signal send [-a +PHONE] RECIPIENT MESSAGE # send one message, exit jerboa-signal listen [-a +PHONE] # stream inbound as NDJSON +jerboa-signal tui [-a +PHONE] # terminal UI shell ``` `-a` is required only if multiple Signal accounts are linked to signal-cli. @@ -50,8 +51,26 @@ Without `make install`, run via the Makefile: ```sh make run ARGS="send +15551234567 hello" make run ARGS="listen" +make run-tui ``` +The TUI needs the small termbox2 shim: + +```sh +make tui-shim +./jerboa-signal tui +``` + +The TUI opens in `signal-cli jsonRpc --receive-mode on-connection`, so new +Signal events arrive while it is running. At startup it preloads active groups +and known contacts into the conversation pane. The current interface keeps +in-memory conversations for this session, routes incoming +data/sync/receipt/typing events into threads, and sends plain text from the +composer to the selected conversation with Enter. Use Up/Down to change the +selected conversation. Use Ctrl-N to open the new-message picker, type to +filter contacts/groups or enter a `+number`, and press Enter to select. Use q, +Esc, or Ctrl-C to quit. + ## Architecture ``` @@ -67,8 +86,11 @@ make run ARGS="listen" Modules: - `signal/main.ss` — entry point, argv parsing, subcommand dispatch - `signal/rpc.ss` — JSON-RPC client over signal-cli's stdin/stdout (NDJSON framing, id correlation, notification queue) +- `signal/rpc-actor.ss` — long-lived JSON-RPC actor for the TUI - `signal/cmd-send.ss` — `send` subcommand - `signal/cmd-listen.ss` — `listen` subcommand +- `signal/cmd-tui.ss` — TUI command entry point; see `docs/TUI_PLAN.md` +- `signal/tui/` — termbox2 FFI and the first terminal shell ## License new file mode 100644 --- /dev/null +++ b/docs/TUI_PLAN.md @@ -0,0 +1,110 @@ +# jerboa-signal TUI Plan + +This project will grow from a small `signal-cli jsonRpc` wrapper into a terminal +Signal client written in Jerboa. The near-term goal is not to reimplement the +Signal protocol. The near-term goal is to own the user interface, local state, +and JSON-RPC orchestration while `signal-cli` continues to own Signal server and +protocol compatibility. + +## Constraints + +- `signal-cli` is the protocol engine for now. +- `signal-cli` must stay current because Signal server behavior changes. +- The TUI must not mutate UI state from worker threads. +- The TUI runs `signal-cli jsonRpc --receive-mode on-connection` so incoming + messages are delivered as JSON-RPC `receive` notifications while the UI is + open. +- Local message storage must be explicit because Signal history is sensitive. +- A newly linked device cannot fetch arbitrary old phone history; it can display + messages received after linking and whatever local history we store. +- Vendoring or deriving from `signal-cli` changes the license posture from ISC + toward GPLv3/AGPL-compatible distribution. Keep process-bound integration + until that is a deliberate project decision. + +## Target Experience + +`jerboa-signal tui [-a +PHONE]` opens a three-pane terminal client: + +```text ++----------------+------------------------------------+----------------+ +| conversations | message thread | details | +| contacts | incoming and outgoing messages | profile/group | +| groups | attachments, receipts, status | identities | ++----------------+------------------------------------+----------------+ +| composer: type message, attach, reply, react, command palette | ++------------------------------------------------------------------------+ +| account | signal-cli status | sync status | unread/errors | ++------------------------------------------------------------------------+ +``` + +## Architecture + +```text +TUI event loop + | + +-- model/store: conversations, messages, contacts, groups + | + +-- rpc actor: long-lived signal-cli jsonRpc process + | + +-- stdin writer: JSON-RPC requests with ids + +-- stdout reader: responses plus receive notifications +``` + +The RPC actor owns `signal-cli` process IO. It correlates responses by request +id and forwards receive notifications to the TUI as events. The TUI main thread +drains events and mutates app state, following the `jerboa-code` TUI pattern. + +## Modules + +- `signal/rpc-actor.ss`: long-lived JSON-RPC process, response correlation, + notification channel. +- `signal/model.ss`: normalized account, conversation, and message records. +- `signal/store.ss`: optional local history/cache with strict file permissions. +- `signal/cmd-tui.ss`: command entry point and TUI lifecycle. +- `signal/tui/*.ss`: terminal rendering, input, dialogs, themes, keybindings. + +## Phases + +1. Done: add this plan and an RPC actor that can run beside the current blocking RPC + client. +2. Done: add a guarded `tui` subcommand scaffold that starts and stops the actor + without sending Signal messages. +3. In progress: add model normalization for accounts, contacts, groups, received + envelopes, sent-message sync events, receipts, and typing events. +4. Done: port a small, Signal-specific termbox2 TUI shell from the `jerboa-code` + pattern: layout, event loop, input box, status bar, toasts. +5. In progress: implement live receive and plain text send from the composer. +6. Add local storage behind an explicit setting: ephemeral by default, durable + JSONL or SQLite when enabled. +7. Add attachments, replies, reactions, receipts, typing indicators, profile + details, group operations, identity trust flows, remote delete, pins, and + polls. +8. Build fake JSON-RPC tests so most behavior is testable without real Signal + traffic. + +## First Milestone + +The first milestone is intentionally backend-heavy: + +- `signal/rpc-actor.ss` can spawn `signal-cli jsonRpc`. +- Multiple JSON-RPC calls can be correlated by id. +- Incoming notifications are available through a non-blocking event drain. +- `jerboa-signal tui` starts the backend in receive mode and opens a terminal + shell when a TTY is available. In noninteractive contexts it prints the + backend status and exits cleanly. + +After that, the terminal renderer can be added on top without changing the +Signal process boundary. + +## Current Status + +- `jerboa-signal tui` uses `--receive-mode on-connection`. +- Startup calls `listGroups` and `listContacts` through the JSON-RPC actor to + seed selectable conversations. +- Ctrl-N opens a new-message picker that filters loaded contacts/groups and can + create a direct conversation for a typed `+number`. +- Incoming receive notifications are routed into in-memory conversations. +- The conversation pane supports Up/Down selection and unread counts. +- Enter sends the current composer text to the selected direct or group + conversation through `signal-cli` JSON-RPC. +- Local history is still ephemeral; quitting the TUI forgets the session. new file mode 100644 --- /dev/null +++ b/signal/cmd-tui.ss @@ -0,0 +1,53 @@ +#!chezscheme +;;; signal/cmd-tui -- terminal UI entry point. +;;; +;;; Starts the long-lived JSON-RPC actor in on-connection receive mode and runs +;;; the termbox2 TUI when stdin/stdout are attached to a terminal. + +(library (signal cmd-tui) + (export cmd-tui) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (std misc process) + (signal rpc-actor) + (signal tui main)) + + (def (cmd-tui account) + (let* ([receive-mode "on-connection"] + [actor (start-signal-actor account receive-mode)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (let* ([version-result (actor-call actor "version" #f)] + [version (if (hashtable? version-result) + (hashtable-ref version-result "version" "unknown") + "unknown")]) + (if (and (tty? (current-input-port)) + (tty? (current-output-port))) + (run-tui-terminal account actor version receive-mode) + (begin + (display "jerboa-signal tui backend scaffold\n") + (display "signal-cli actor pid: ") + (display (signal-actor-pid actor)) + (newline) + (display "signal-cli version: ") + (display version) + (newline) + (display "receive mode: ") + (display receive-mode) + (newline) + (display "terminal renderer: requires a TTY") + (newline) + (display "roadmap: docs/TUI_PLAN.md\n"))))) + (lambda () (stop-signal-actor actor))))) + + ) ;; end library --- a/signal/main.ss +++ b/signal/main.ss @@ -34,7 +34,8 @@ (import (except (jerboa prelude) meta atom?) (signal cmd-send) - (signal cmd-listen)) + (signal cmd-listen) + (signal cmd-tui)) (def *version* "0.1.0") @@ -45,6 +46,7 @@ Subcommands: send [-a +PHONE] RECIPIENT MESSAGE Send a Signal message listen [-a +PHONE] Stream inbound envelopes as NDJSON + tui [-a +PHONE] Start the terminal UI version Print version help Print this help @@ -90,6 +92,15 @@ linking once before using this tool: [(string=? sub "listen") (let-values ([(account args) (parse-account-flag rest)]) (cmd-listen account))] + [(string=? sub "tui") + (let-values ([(account args) (parse-account-flag rest)]) + (cond + [(not (null? args)) + (display "jerboa-signal: tui takes no positional arguments\n" + (current-error-port)) + (exit 2)] + [else + (cmd-tui account)]))] [else (display "jerboa-signal: unknown subcommand: " (current-error-port)) (display sub (current-error-port)) new file mode 100644 --- /dev/null +++ b/signal/rpc-actor.ss @@ -0,0 +1,267 @@ +#!chezscheme +;;; signal/rpc-actor -- long-lived JSON-RPC actor for signal-cli. +;;; +;;; The existing (signal rpc) module is synchronous and reads stdout inside each +;;; call. That is fine for one-shot commands, but a TUI needs one reader that +;;; continuously demultiplexes request responses and receive notifications. + +(library (signal rpc-actor) + (export + start-signal-actor + stop-signal-actor + signal-actor? + signal-actor-pid + signal-actor-closed? + + actor-call + actor-try-event + actor-drain-events) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (std csp) + (std misc process) + (std text json)) + + ;; proc : process-port-rec + ;; next-id-box : box holding the next JSON-RPC id + ;; pending : id -> response channel + ;; lock : protects next-id-box, pending, closed-box, and stdin writes + ;; events : non-blocking notification/error stream for the caller + ;; reader : reader thread handle + ;; closed-box : box boolean + (defstruct signal-actor (proc next-id-box pending lock events reader closed-box)) + + (def (start-signal-actor account . maybe-receive-mode) + ;; Use manual receive mode by default. The future TUI can explicitly call + ;; subscribeReceive when it is ready to route notifications into app state. + (let* ([receive-mode (if (pair? maybe-receive-mode) + (car maybe-receive-mode) + "manual")] + [cmd (if account + (list "signal-cli" "-a" account + "jsonRpc" "--receive-mode" receive-mode) + (list "signal-cli" + "jsonRpc" "--receive-mode" receive-mode))] + [proc (open-process cmd)] + [actor (make-signal-actor proc + (box 1) + (make-hashtable equal-hash equal?) + (make-mutex) + (make-channel/sliding 1024) + #f + (box #f))] + [reader (fork-thread (lambda () (actor-reader-loop actor)))]) + (signal-actor-reader-set! actor reader) + actor)) + + (def (signal-actor-pid actor) + (process-port-pid (signal-actor-proc actor))) + + (def (signal-actor-closed? actor) + (unbox (signal-actor-closed-box actor))) + + (def (stop-signal-actor actor) + (let ([already-closed? + (with-actor-lock actor + (lambda () + (let ([closed? (signal-actor-closed? actor)]) + (unless closed? + (set-box! (signal-actor-closed-box actor) #t)) + closed?)))]) + (unless already-closed? + (fail-all-pending! actor "signal-cli actor stopped") + (chan-close! (signal-actor-events actor)) + (let ([proc (signal-actor-proc actor)]) + (close-port (process-port-rec-stdin-port proc)) + (process-kill (process-port-pid proc) 15)))) + (void)) + + (def (actor-call actor method params) + (when (signal-actor-closed? actor) + (error 'actor-call "signal-cli actor is closed")) + (let* ([id (next-id! actor)] + [reply (make-channel 1)] + [req (make-rpc-request id method params)]) + (register-pending! actor id reply) + (guard (e [#t + (remove-pending! actor id) + (raise e)]) + (write-frame actor req)) + (let ([msg (chan-get! reply)]) + (cond + [(eof-object? msg) + (error 'actor-call "signal-cli actor closed before responding")] + [(actor-error? msg) + (error 'actor-call (cdr msg))] + [else + (rpc-response-result-or-raise msg)])))) + + (def (actor-try-event actor) + (chan-try-get (signal-actor-events actor))) + + (def (actor-drain-events actor) + (let loop ([acc '()]) + (let ([ev (actor-try-event actor)]) + (if ev + (loop (cons ev acc)) + (reverse acc))))) + + ;; --- Reader loop --- + + (def (actor-reader-loop actor) + (guard (e [#t + (let ([msg (condition->string e)]) + (emit-event! actor (list 'error msg)) + (mark-closed! actor msg))]) + (let loop () + (unless (signal-actor-closed? actor) + (let ([msg (read-frame actor)]) + (cond + [(eof-object? msg) + (mark-closed! actor "signal-cli closed stdout")] + [(rpc-notification? msg) + (emit-event! actor (list 'notification msg)) + (loop)] + [(has-rpc-id? msg) + (deliver-response! actor msg) + (loop)] + [else + (emit-event! actor (list 'unknown msg)) + (loop)])))))) + + (def (mark-closed! actor reason) + (with-actor-lock actor + (lambda () + (set-box! (signal-actor-closed-box actor) #t))) + (emit-event! actor (list 'closed reason)) + (fail-all-pending! actor reason) + (chan-close! (signal-actor-events actor))) + + (def (emit-event! actor ev) + ;; The event channel is sliding, so this will not block the reader thread. + (chan-try-put! (signal-actor-events actor) ev) + (void)) + + (def (deliver-response! actor msg) + (let* ([id (hashtable-ref msg "id" #f)] + [reply (with-actor-lock actor + (lambda () + (let ([ch (hashtable-ref (signal-actor-pending actor) id #f)]) + (when ch + (hashtable-delete! (signal-actor-pending actor) id)) + ch)))]) + (if reply + (begin (chan-try-put! reply msg) (void)) + (emit-event! actor (list 'orphan-response msg))))) + + (def (fail-all-pending! actor reason) + (let ([channels + (with-actor-lock actor + (lambda () + (let-values ([(keys vals) + (hashtable-entries (signal-actor-pending actor))]) + (let loop ([i 0] [acc '()]) + (if (= i (vector-length vals)) + (begin + (hashtable-clear! (signal-actor-pending actor)) + acc) + (loop (+ i 1) (cons (vector-ref vals i) acc)))))))]) + (for-each + (lambda (ch) + (chan-try-put! ch (cons 'actor-error reason)) + (chan-close! ch)) + channels))) + + ;; --- Request/response helpers --- + + (def (with-actor-lock actor thunk) + (let ([lock (signal-actor-lock actor)]) + (dynamic-wind + (lambda () (mutex-acquire lock)) + thunk + (lambda () (mutex-release lock))))) + + (def (next-id! actor) + (with-actor-lock actor + (lambda () + (let* ([b (signal-actor-next-id-box actor)] + [n (unbox b)]) + (set-box! b (+ n 1)) + n)))) + + (def (register-pending! actor id reply) + (with-actor-lock actor + (lambda () + (when (signal-actor-closed? actor) + (error 'actor-call "signal-cli actor is closed")) + (hashtable-set! (signal-actor-pending actor) id reply)))) + + (def (remove-pending! actor id) + (with-actor-lock actor + (lambda () + (hashtable-delete! (signal-actor-pending actor) id)))) + + (def (write-frame actor obj) + (with-actor-lock actor + (lambda () + (when (signal-actor-closed? actor) + (error 'actor-call "signal-cli actor is closed")) + (let ([port (process-port-rec-stdin-port (signal-actor-proc actor))]) + (display (json-object->string obj) port) + (newline port) + (flush-output-port port))))) + + (def (read-frame actor) + (let* ([port (process-port-rec-stdout-port (signal-actor-proc actor))] + [line (get-line port)]) + (if (eof-object? line) + line + (string->json-object line)))) + + (def (make-rpc-request id method params) + (let ([h (make-hashtable equal-hash equal?)]) + (hashtable-set! h "jsonrpc" "2.0") + (hashtable-set! h "id" id) + (hashtable-set! h "method" method) + (when params (hashtable-set! h "params" params)) + h)) + + (def (has-rpc-id? msg) + (and (hashtable? msg) + (hashtable-ref msg "id" #f))) + + (def (rpc-notification? msg) + (and (hashtable? msg) + (not (hashtable-ref msg "id" #f)) + (hashtable-ref msg "method" #f))) + + (def (rpc-response-result-or-raise msg) + (let ([err (hashtable-ref msg "error" #f)]) + (if err + (error 'actor-call + (if (hashtable? err) + (or (hashtable-ref err "message" #f) "rpc error") + "rpc error") + err) + (hashtable-ref msg "result" #f)))) + + (def (actor-error? msg) + (and (pair? msg) (eq? (car msg) 'actor-error))) + + (def (condition->string e) + (let ([p (open-output-string)]) + (cond + [(condition? e) (display-condition e p)] + [else (display e p)]) + (get-output-string p))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/signal/tui/ffi.ss @@ -0,0 +1,213 @@ +#!chezscheme +;;; signal/tui/ffi -- termbox2 bindings for jerboa-signal. + +(library (signal tui ffi) + (export + tb-init! tb-shutdown! with-tui + tb-width tb-height + tb-clear! tb-present! tb-set-cursor! tb-hide-cursor! + tb-change-cell! tb-set-clear-attrs! tb-print! + tb-set-input-mode! tb-set-output-mode! + tb-poll-event tb-peek-event + make-tui-event tui-event? tui-event-type tui-event-mod + tui-event-key tui-event-ch tui-event-w tui-event-h + tui-event-x tui-event-y + tui-event-key? tui-event-resize? tui-event-mouse? + TB_EVENT_KEY TB_EVENT_RESIZE TB_EVENT_MOUSE + TB_KEY_ARROW_UP TB_KEY_ARROW_DOWN TB_KEY_ARROW_LEFT TB_KEY_ARROW_RIGHT + TB_KEY_PGUP TB_KEY_PGDN + TB_KEY_BACKSPACE TB_KEY_BACKSPACE2 TB_KEY_TAB TB_KEY_BACK_TAB TB_KEY_ENTER + TB_KEY_ESC TB_KEY_SPACE + TB_KEY_MOUSE_WHEEL_UP TB_KEY_MOUSE_WHEEL_DOWN + TB_KEY_CTRL_A TB_KEY_CTRL_B TB_KEY_CTRL_C TB_KEY_CTRL_D + TB_KEY_CTRL_E TB_KEY_CTRL_J TB_KEY_CTRL_K TB_KEY_CTRL_L + TB_KEY_CTRL_N TB_KEY_CTRL_Q + TB_INPUT_ESC TB_INPUT_MOUSE + TB_OUTPUT_TRUECOLOR + TB_DEFAULT TB_BLACK TB_RED TB_GREEN TB_YELLOW + TB_BLUE TB_MAGENTA TB_CYAN TB_WHITE + TB_BOLD TB_REVERSE TB_DIM) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (std os path)) + + (def (not-empty-env? name) + (let ([v (getenv name)]) + (and v (not (string=? v ""))))) + + (def *shim-load-state* (box 'untried)) + + (def (try-load-shim path) + (and (file-exists? path) + (load-shared-object path))) + + (def (ensure-shim-loaded!) + (cond + [(eq? (unbox *shim-load-state*) 'loaded) #t] + [(not-empty-env? "JERBOA_STATIC") + (set-box! *shim-load-state* 'loaded) + #t] + [else + (let* ([bin-dir (path-directory (car (command-line)))] + [home (or (getenv "HOME") ".")] + [loaded? + (or (try-load-shim "signal_tui_shim.dylib") + (try-load-shim "signal_tui_shim.so") + (try-load-shim (path-join bin-dir "signal_tui_shim.dylib")) + (try-load-shim (path-join bin-dir "signal_tui_shim.so")) + (try-load-shim (path-join home ".local" "bin" + "signal_tui_shim.dylib")) + (try-load-shim "vendor/termbox2/signal_tui_shim.dylib") + (try-load-shim "vendor/termbox2/signal_tui_shim.so"))]) + (set-box! *shim-load-state* (if loaded? 'loaded 'missing)) + loaded?)])) + + (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))))) + + (define-tb c-tb-init "signal_tb_init" () int) + (define-tb c-tb-shutdown "signal_tb_shutdown" () void) + (define-tb c-tb-width "signal_tb_width" () int) + (define-tb c-tb-height "signal_tb_height" () int) + (define-tb c-tb-clear "signal_tb_clear" () void) + (define-tb c-tb-present "signal_tb_present" () void) + (define-tb c-tb-set-cursor "signal_tb_set_cursor" (int int) void) + (define-tb c-tb-hide-cursor "signal_tb_hide_cursor" () void) + (define-tb c-tb-change-cell "signal_tb_change_cell" + (int int unsigned-32 unsigned-32 unsigned-32) void) + (define-tb c-tb-set-clear "signal_tb_set_clear_attrs" + (unsigned-32 unsigned-32) void) + (define-tb c-tb-print "signal_tb_print" + (int int unsigned-32 unsigned-32 string) int) + (define-tb c-tb-set-input "signal_tb_set_input_mode" (int) int) + (define-tb c-tb-set-output "signal_tb_set_output_mode" (int) int) + (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")))) + + (define-tb c-tb-ev-type "signal_tb_event_type" () int) + (define-tb c-tb-ev-mod "signal_tb_event_mod" () int) + (define-tb c-tb-ev-key "signal_tb_event_key" () int) + (define-tb c-tb-ev-ch "signal_tb_event_ch" () unsigned-32) + (define-tb c-tb-ev-w "signal_tb_event_w" () int) + (define-tb c-tb-ev-h "signal_tb_event_h" () int) + (define-tb c-tb-ev-x "signal_tb_event_x" () int) + (define-tb c-tb-ev-y "signal_tb_event_y" () int) + + (defstruct tui-event (type mod key ch w h x y)) + + (def (read-event!) + (make-tui-event + (c-tb-ev-type) (c-tb-ev-mod) (c-tb-ev-key) (c-tb-ev-ch) + (c-tb-ev-w) (c-tb-ev-h) (c-tb-ev-x) (c-tb-ev-y))) + + (def TB_EVENT_KEY 1) + (def TB_EVENT_RESIZE 2) + (def TB_EVENT_MOUSE 3) + + (def TB_KEY_ARROW_UP (- #xFFFF 18)) + (def TB_KEY_ARROW_DOWN (- #xFFFF 19)) + (def TB_KEY_ARROW_LEFT (- #xFFFF 20)) + (def TB_KEY_ARROW_RIGHT (- #xFFFF 21)) + (def TB_KEY_PGUP (- #xFFFF 16)) + (def TB_KEY_PGDN (- #xFFFF 17)) + (def TB_KEY_BACK_TAB (- #xFFFF 22)) + (def TB_KEY_BACKSPACE #x08) + (def TB_KEY_BACKSPACE2 #x7F) + (def TB_KEY_TAB #x09) + (def TB_KEY_ENTER #x0D) + (def TB_KEY_ESC #x1B) + (def TB_KEY_SPACE #x20) + (def TB_KEY_MOUSE_WHEEL_UP (- #xFFFF 27)) + (def TB_KEY_MOUSE_WHEEL_DOWN (- #xFFFF 28)) + + (def TB_KEY_CTRL_A #x01) + (def TB_KEY_CTRL_B #x02) + (def TB_KEY_CTRL_C #x03) + (def TB_KEY_CTRL_D #x04) + (def TB_KEY_CTRL_E #x05) + (def TB_KEY_CTRL_J #x0A) + (def TB_KEY_CTRL_K #x0B) + (def TB_KEY_CTRL_L #x0C) + (def TB_KEY_CTRL_N #x0E) + (def TB_KEY_CTRL_Q #x11) + + (def TB_INPUT_ESC 1) + (def TB_INPUT_MOUSE 4) + (def TB_OUTPUT_TRUECOLOR 5) + + (def TB_DEFAULT #x0000) + (def TB_BLACK #x0001) + (def TB_RED #x0002) + (def TB_GREEN #x0003) + (def TB_YELLOW #x0004) + (def TB_BLUE #x0005) + (def TB_MAGENTA #x0006) + (def TB_CYAN #x0007) + (def TB_WHITE #x0008) + + (def TB_BOLD #x01000000) + (def TB_REVERSE #x04000000) + (def TB_DIM #x80000000) + + (def (tb-init!) + (let ([rc (c-tb-init)]) + (when (< rc 0) + (error 'tb-init! "termbox init failed" rc)) + rc)) + + (def (tb-shutdown!) (c-tb-shutdown)) + + (defrule (with-tui body ...) + (dynamic-wind + (lambda () (tb-init!)) + (lambda () body ...) + (lambda () (tb-shutdown!)))) + + (def (tb-width) (c-tb-width)) + (def (tb-height) (c-tb-height)) + (def (tb-clear!) (c-tb-clear)) + (def (tb-present!) (c-tb-present)) + (def (tb-set-cursor! x y) (c-tb-set-cursor x y)) + (def (tb-hide-cursor!) (c-tb-hide-cursor)) + (def (tb-change-cell! x y ch fg bg) (c-tb-change-cell x y ch fg bg)) + (def (tb-set-clear-attrs! fg bg) (c-tb-set-clear fg bg)) + (def (tb-print! x y fg bg str) (c-tb-print x y fg bg str)) + (def (tb-set-input-mode! mode) (c-tb-set-input mode)) + (def (tb-set-output-mode! mode) (c-tb-set-output mode)) + + (def (tb-poll-event) + (let ([rc (c-tb-poll)]) + (if (= rc 0) (read-event!) #f))) + + (def (tb-peek-event timeout-ms) + (let ([rc (c-tb-peek timeout-ms)]) + (if (= rc 0) (read-event!) #f))) + + (def (tui-event-key? ev) (= (tui-event-type ev) TB_EVENT_KEY)) + (def (tui-event-resize? ev) (= (tui-event-type ev) TB_EVENT_RESIZE)) + (def (tui-event-mouse? ev) (= (tui-event-type ev) TB_EVENT_MOUSE)) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/signal/tui/main.ss @@ -0,0 +1,1011 @@ +#!chezscheme +;;; signal/tui/main -- first terminal shell for jerboa-signal. + +(library (signal tui main) + (export run-tui-terminal) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (signal rpc-actor) + (signal tui ffi)) + + (defstruct chat-message (direction sender text timestamp kind)) + (defstruct conversation (id title kind target messages unread)) + (defstruct tui-state + (account version receive-mode width height input status quit? event-count + conversations selected-index mode picker-query picker-index)) + + (def (run-tui-terminal account actor version receive-mode) + (with-tui + (tb-set-input-mode! (bitwise-ior TB_INPUT_ESC TB_INPUT_MOUSE)) + (tb-set-output-mode! TB_OUTPUT_TRUECOLOR) + (let ([state (make-tui-state (or account "default") + version + receive-mode + (tb-width) + (tb-height) + "" + "Backend connected." + #f + 0 + (list + (make-system-conversation + (list + "TUI connected. Waiting for Signal receive notifications." + "Session history is in memory only."))) + 0 + 'chat + "" + 0)]) + (tb-hide-cursor!) + (draw! state) + (tb-present!) + (seed-known-conversations! state actor) + (event-loop state actor)))) + + (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)))) + + (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 ([chat-event (notification->chat-event (cadr ev))]) + (if chat-event + (begin + (apply-chat-event! state chat-event) + (tui-state-status-set! state "New Signal message received.")) + (let ([line (notification->line (cadr ev))]) + (when line + (append-system-message! state line) + (tui-state-status-set! state "New Signal event received.")))))] + [(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.")] + [else (void)])) + events)))) + + (def (make-system-conversation lines) + (make-conversation "system" + "System" + 'system + #f + (map (lambda (line) + (make-chat-message 'system "system" line #f 'system)) + lines) + 0)) + + (def (append-system-message! state line) + (let ([conv (ensure-conversation! state "system" "System" 'system #f)]) + (append-message-to-conversation! + conv + (make-chat-message 'system "system" line #f 'system)))) + + (def (append-message-to-conversation! conv msg) + (let* ([messages (conversation-messages conv)] + [next (append messages (list msg))] + [trimmed (if (> (length next) 200) + (drop-oldest next (- (length next) 200)) + next)]) + (conversation-messages-set! conv trimmed))) + + (def (apply-chat-event! state chat-event) + (let* ([id (list-ref chat-event 0)] + [title (list-ref chat-event 1)] + [kind (list-ref chat-event 2)] + [target (list-ref chat-event 3)] + [msg (list-ref chat-event 4)] + [conv (ensure-conversation! state id title kind target)]) + (append-message-to-conversation! conv msg) + (unless (selected-conversation? state id) + (conversation-unread-set! conv (+ (conversation-unread conv) 1))))) + + (def (seed-known-conversations! state actor) + (tui-state-status-set! state "Loading contacts and groups...") + (let* ([group-count (seed-groups! state actor)] + [contact-count (seed-contacts! state actor)]) + (tui-state-status-set! + state + (string-append "Loaded " + (number->string contact-count) + " contacts and " + (number->string group-count) + " groups.")))) + + (def (seed-groups! state actor) + (seed-group-list! state (actor-list-or-empty state actor "listGroups" "groups"))) + + (def (seed-contacts! state actor) + (seed-contact-list! state + (actor-list-or-empty state actor + "listContacts" + "contacts"))) + + (def (actor-list-or-empty state actor method label) + (guard (e [#t + (append-system-message! + state + (string-append "Could not load " label ": " (safe-display e))) + '()]) + (let ([result (actor-call actor method #f)]) + (if (list? result) + result + (begin + (append-system-message! + state + (string-append "Unexpected " label " response from signal-cli.")) + '()))))) + + (def (seed-group-list! state groups) + (let loop ([xs groups] [count 0]) + (cond + [(null? xs) count] + [else + (loop (cdr xs) + (+ count (if (seed-group-conversation! state (car xs)) 1 0)))]))) + + (def (seed-contact-list! state contacts) + (let loop ([xs contacts] [count 0]) + (cond + [(null? xs) count] + [else + (loop (cdr xs) + (+ count (if (seed-contact-conversation! state (car xs)) 1 0)))]))) + + (def (seed-group-conversation! state group) + (and (hashtable? group) + (hashtable-ref group "isMember" #f) + (let ([id (first-non-empty-string (hashtable-ref group "id" #f))]) + (and id