macOS port + URL migration + assorted Qt fixes
ober
6b8db629fcd793c769629fb02a894f6d7b02c5ce
--- a/Makefile +++ b/Makefile @@ -6,7 +6,8 @@ GHERKIN = $(if $(wildcard vendor/gherkin-runtime),vendor/gherkin-runtime,$(HOM JAWS = $(if $(wildcard vendor/jerboa-aws),vendor/jerboa-aws,$(HOME)/mine/jerboa-aws) CSSL = $(if $(wildcard vendor/chez-ssl/src),vendor/chez-ssl/src,$(HOME)/mine/chez-ssl/src) CHTTPS = $(if $(wildcard vendor/chez-https/src),vendor/chez-https/src,$(HOME)/mine/chez-https/src) -LIBDIRS = --libdirs lib:$(JERBOA)/lib:$(JSH):$(COREUTILS):$(GHERKIN):$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla/src:$(HOME)/mine/chez-qt:$(JAWS):$(CSSL):$(CHTTPS) +CQT = $(if $(wildcard vendor/chez-qt/chez-qt/qt.ss),vendor/chez-qt,$(HOME)/mine/chez-qt) +LIBDIRS = --libdirs lib:$(JERBOA)/lib:$(JSH):$(COREUTILS):$(GHERKIN):$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla/src:$(CQT):$(JAWS):$(CSSL):$(CHTTPS) JERBUILD = $(SCHEME) --libdirs $(JERBOA)/lib --script $(JERBOA)/jerbuild.ss # --- Platform detection ------------------------------------------------------- @@ -36,7 +37,7 @@ else TS_INC := /opt/tree-sitter-include TS_LIB_DIR := /opt/tree-sitter-lib endif -PRELOAD_ENV := $(PRELOAD_VAR)=./qt_chez_shim.$(SHLIB_EXT) +PRELOAD_ENV := $(PRELOAD_VAR)=./qt_chez_shim.$(SHLIB_EXT):./libjerboa_native.$(SHLIB_EXT):./libjsh-ffi.$(SHLIB_EXT) # ----------------------------------------------------------------------------- export CHEZ_SCINTILLA_LIB := $(HOME)/mine/chez-scintilla @@ -58,6 +59,7 @@ endif linux-tui linux-tui-local \ linux-qt linux-qt-local \ stress-run stress-run-static stress-test stress-burn stress-burn-static \ + scenario-test scenario-burn scenario-burn-static \ test-behavioral all: @@ -1052,6 +1054,95 @@ stress-burn-static: echo "=== STRESS LOG (last 50 lines) ==="; \ tail -50 stress-test.log 2>/dev/null +# ============================================================================= +# Scenario runner — coherent user workflows, screenshots, assertions, hours +# ============================================================================= + +# Run scenario driver against an already-running jemacs-qt REPL. +# Pass HOURS=N or CYCLES=N to control duration (default: infinite). +# Pass NO_SHOTS=1 to skip screenshots (saves disk for very long runs). +SCENARIO_PORT ?= 9999 +SCENARIO_HOURS ?= +SCENARIO_CYCLES ?= +SCENARIO_NO_SHOTS ?= + +scenario-test: + $(SCHEME) $(LIBDIRS) --script tests/scenario-runner.ss \ + --port $(SCENARIO_PORT) \ + $(if $(SCENARIO_HOURS),--hours $(SCENARIO_HOURS)) \ + $(if $(SCENARIO_CYCLES),--cycles $(SCENARIO_CYCLES)) \ + $(if $(SCENARIO_NO_SHOTS),--no-screenshots) + +# All-in-one: launch interpreted jemacs-qt + run scenario driver +scenario-burn: build repl_shim.$(SHLIB_EXT) libqt_shim.$(SHLIB_EXT) vterm_shim.$(SHLIB_EXT) qt_chez_shim.$(SHLIB_EXT) + @echo "=== Starting jemacs-qt scenario burn-in ===" + @rm -f $(HOME)/.jerboa-repl-port scenario-run.log scenario-failures.log + @rm -rf scenario-screenshots + $(XVFB_RUN) env CHEZ_QT_SHIM_DIR=$(CURDIR) $(PRELOAD_ENV) \ + $(SCHEME) $(LIBDIRS) --script $(CURDIR)/qt-main.ss --repl 0 & + @for i in $$(seq 1 30); do \ + [ -f $(HOME)/.jerboa-repl-port ] && break; \ + sleep 0.5; \ + done + @if [ ! -f $(HOME)/.jerboa-repl-port ]; then \ + echo "ERROR: jemacs-qt failed to start (no REPL port file after 15s)"; exit 1; \ + fi + @PORT=$$(grep -oE '[0-9]+' $(HOME)/.jerboa-repl-port | head -1); \ + echo "jemacs-qt running on REPL port $$PORT"; \ + $(SCHEME) $(LIBDIRS) --script tests/scenario-runner.ss --port $$PORT \ + $(if $(SCENARIO_HOURS),--hours $(SCENARIO_HOURS)) \ + $(if $(SCENARIO_CYCLES),--cycles $(SCENARIO_CYCLES)) \ + $(if $(SCENARIO_NO_SHOTS),--no-screenshots); \ + RC=$$?; \ + echo ""; \ + echo "=== Scenario run ended (rc=$$RC) ==="; \ + if [ -f $(HOME)/.jemacs-crash.log ]; then \ + echo "=== CRASH LOG ==="; \ + cat $(HOME)/.jemacs-crash.log; \ + fi; \ + echo "=== FAILURES ==="; \ + [ -f scenario-failures.log ] && cat scenario-failures.log || echo "(no failures)"; \ + echo "=== TIMELINE (last 80 lines) ==="; \ + tail -80 scenario-run.log 2>/dev/null + +# All-in-one: launch static jemacs-qt under gdb + run scenario driver +scenario-burn-static: + @echo "=== Starting jemacs-qt (static) scenario burn-in under gdb ===" + @rm -f $(HOME)/.jerboa-repl-port scenario-run.log scenario-failures.log + @rm -rf scenario-screenshots + @xvfb-run -a gdb -batch \ + -ex 'handle SIGALRM nostop noprint' \ + -ex 'handle SIG34 nostop noprint' \ + -ex run \ + -ex 'bt full' \ + -ex 'thread apply all bt full' \ + -ex 'info registers' \ + --args ./jemacs-qt --repl 0 & + @for i in $$(seq 1 30); do \ + [ -f $(HOME)/.jerboa-repl-port ] && break; \ + sleep 0.5; \ + done + @if [ ! -f $(HOME)/.jerboa-repl-port ]; then \ + echo "ERROR: jemacs-qt failed to start (no REPL port file after 15s)"; exit 1; \ + fi + @PORT=$$(grep -oE '[0-9]+' $(HOME)/.jerboa-repl-port | head -1); \ + echo "jemacs-qt (static) running under gdb on REPL port $$PORT"; \ + $(SCHEME) $(LIBDIRS) --script tests/scenario-runner.ss --port $$PORT \ + $(if $(SCENARIO_HOURS),--hours $(SCENARIO_HOURS)) \ + $(if $(SCENARIO_CYCLES),--cycles $(SCENARIO_CYCLES)) \ + $(if $(SCENARIO_NO_SHOTS),--no-screenshots); \ + RC=$$?; \ + echo ""; \ + echo "=== Scenario run ended (rc=$$RC) ==="; \ + if [ -f $(HOME)/.jemacs-crash.log ]; then \ + echo "=== CRASH LOG ==="; \ + cat $(HOME)/.jemacs-crash.log; \ + fi; \ + echo "=== FAILURES ==="; \ + [ -f scenario-failures.log ] && cat scenario-failures.log || echo "(no failures)"; \ + echo "=== TIMELINE (last 80 lines) ==="; \ + tail -80 scenario-run.log 2>/dev/null + # Behavioral regression tests: headless jemacs-qt + deterministic REPL test driver # Tests key routing, window splitting, terminal focus, and related invariants. test-behavioral: build repl_shim.so libqt_shim.so vterm_shim.so qt_chez_shim.so --- a/docs/shell.md +++ b/docs/shell.md @@ -56,7 +56,7 @@ This makes `:jsh/...` modules importable via `GERBIL_LOADPATH`. (depend: (github: "ober/gerbil-pcre2") (github: "ober/gerbil-scintilla") (github: "ober/gerbil-qt") - (github: "ober/jerboa-shell")) + (sourcehut: "~lisp/jerboa-shell")) ``` ### 1c. Update `build.ss` @@ -77,7 +77,7 @@ The static build (`make static-qt`) needs jsh compiled inside the Docker image: ```dockerfile # In Dockerfile.deps -RUN jerboa pkg install github.com/ober/jerboa-shell +RUN jerboa pkg install git.sr.ht/~lisp/jerboa-shell ``` Add to `Makefile`: --- a/lib/jerboa-emacs/async.sls +++ b/lib/jerboa-emacs/async.sls @@ -552,8 +552,8 @@ (let ([v (hashtable-ref cache key - '#{miss jdswg0innsj0c7bc23vlvqgfo-1})]) - (if (eq? v '#{miss jdswg0innsj0c7bc23vlvqgfo-2}) + '#{miss m2sysvihyw6o2j2h65catulgv-0})]) + (if (eq? v '#{miss m2sysvihyw6o2j2h65catulgv-1}) (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 @@ -304,7 +304,7 @@ (loop (+ r 1)))))) (def (parse-repl-port args) "Return (port-num . filtered-args) if --repl <port> is present, else #f." - (let loop ([rest args] [acc (list)]) + (let loop ([rest args] [acc '()]) (cond [(null? rest) #f] [(and (string=? (car rest) "--repl") @@ -359,7 +359,7 @@ [(hash-table? cmd) "+prefix"] [(symbol? cmd) (command-name->description cmd)] [else "?"]))] - [strs (let loop ([es entries] [acc (list)]) + [strs (let loop ([es entries] [acc '()]) (if (null? es) (reverse acc) (let* ([e (car es)] @@ -2044,7 +2044,7 @@ #f))) (ed-loop (cdr wins)))))))) (when (and ts (terminal-pty-busy? ts)) - (let drain ([chunks (list)] + (let drain ([chunks '()] [bytes 0] [done-msg #f]) (if (and (> bytes 0) @@ -2648,15 +2648,45 @@ (master-timer-tick!))))) (def ffi-umask (foreign-procedure "umask" (unsigned-32) unsigned-32)) - (def (qt-main . args) (ffi-umask 63) + (def (qt-main . args) + (display "TRACE qt-main: enter\n" (current-error-port)) + (flush-output-port (current-error-port)) (ffi-umask 63) + (display + "TRACE qt-main: after ffi-umask\n" + (current-error-port)) + (flush-output-port (current-error-port)) (pin-thread-to-processor0! (current-thread)) + (display + "TRACE qt-main: after pin-thread\n" + (current-error-port)) + (flush-output-port (current-error-port)) (setenv "QT_IM_MODULE" "compose") (setenv "QT_ACCESSIBILITY" "0") + (display + "TRACE qt-main: about to qt-app-create\n" + (current-error-port)) + (flush-output-port (current-error-port)) (let ([qt-app (qt-app-create)]) + (display + "TRACE qt-main: qt-app-create returned\n" + (current-error-port)) + (flush-output-port (current-error-port)) (set! *qt-app-ref* qt-app) (automation-set-qt-app! qt-app) - (try (qt-do-init! qt-app args) - (qt-app-exec! qt-app *master-timer-tick-fn*) (lsp-stop!) + (try (display + "TRACE qt-main: about to qt-do-init!\n" + (current-error-port)) + (flush-output-port (current-error-port)) + (qt-do-init! qt-app args) + (display + "TRACE qt-main: qt-do-init! returned, about to qt-app-exec!\n" + (current-error-port)) + (flush-output-port (current-error-port)) + (qt-app-exec! qt-app *master-timer-tick-fn*) + (display + "TRACE qt-main: qt-app-exec! returned (event loop ended)\n" + (current-error-port)) + (flush-output-port (current-error-port)) (lsp-stop!) (stop-ipc-server!) (stop-debug-repl!) (finally (qt-app-quit! qt-app) (qt-app-destroy! qt-app))))) (def (qt-open-file! app filename (on-loaded #f)) --- a/lib/jerboa-emacs/qt/automation.sls +++ b/lib/jerboa-emacs/qt/automation.sls @@ -181,7 +181,15 @@ (def (automation-screenshot! app path) (let* ([fr (app-state-frame app)] [main-win (qt-frame-main-win fr)]) - (if main-win (qt-widget-screenshot! main-win path) #f))) + (if main-win + (begin + (unless (qt-widget-visible? main-win) + (qt-widget-show! main-win)) + (when *qt-app-ref* + (qt-app-process-events! *qt-app-ref*) + (qt-app-process-events! *qt-app-ref*)) + (qt-widget-screenshot! main-win path)) + #f))) (def (automation-state app) (let* ([fr (app-state-frame app)] [buf (qt-current-buffer fr)] --- a/lib/jerboa-emacs/qt/commands-aliases2.sls +++ b/lib/jerboa-emacs/qt/commands-aliases2.sls @@ -303,7 +303,7 @@ "Replace all whole-word occurrences of word with replacement in text.\n Returns (values new-text count)." (let ([wlen (string-length word)] [tlen (string-length text)] - [parts (list)] + [parts '()] [count 0] [last-end 0]) (let loop ([i 0]) @@ -500,8 +500,7 @@ (def (cmd-forge-list-prs app) "List open pull requests for the current project." (let* ([echo (app-state-echo app)] - [output (qt-forge-run-gh - (list "pr" "list" "--limit" "20"))]) + [output (qt-forge-run-gh ("pr" "list" "--limit" "20"))]) (if (not output) (echo-error! echo @@ -522,8 +521,7 @@ (def (cmd-forge-list-issues app) "List open issues for the current project." (let* ([echo (app-state-echo app)] - [output (qt-forge-run-gh - (list "issue" "list" "--limit" "20"))]) + [output (qt-forge-run-gh ("issue" "list" "--limit" "20"))]) (if (not output) (echo-error! echo @@ -546,7 +544,7 @@ (let* ([echo (app-state-echo app)] [num (qt-echo-read-string echo "PR number: ")]) (when (and num (not (string=? num ""))) - (let ([output (qt-forge-run-gh (list "pr" "view" num))]) + (let ([output (qt-forge-run-gh ("pr" "view" num))]) (if (not output) (echo-error! echo @@ -573,7 +571,7 @@ [title (qt-echo-read-string echo "PR title: ")]) (when (and title (not (string=? title ""))) (let ([output (qt-forge-run-gh - (list "pr" "create" "--title" title "--fill"))]) + ("pr" "create" "--title" title "--fill"))]) (if (not output) (echo-error! echo "forge: failed to create PR") (echo-message! @@ -581,8 +579,7 @@ (string-append "Created: " (string-trim output)))))))) (define *qt-custom-groups*--cell (vector (make-hash-table))) (def (qt-custom-group-add! group var-name) - (let ([vars (or (hash-get *qt-custom-groups* group) - (list))]) + (let ([vars (or (hash-get *qt-custom-groups* group) '())]) (unless (member var-name vars) (hash-put! *qt-custom-groups* group (cons var-name vars))))) (define *qt-face-definitions*--cell @@ -596,14 +593,14 @@ *qt-advice-before* *qt-advice-after*)] [entry (cons fn advice-name)]) - (let ([existing (or (hash-get table symbol) (list))]) + (let ([existing (or (hash-get table symbol) '())]) (hash-put! table symbol (cons entry existing))))) (def (cmd-describe-advice app) "Show active advice (Qt)." (let* ([ed (current-qt-editor app)] [echo (app-state-echo app)] [fr (app-state-frame app)] - [lines (list "Command Advice" "==============" "")]) + [lines ("Command Advice" "==============" "")]) (hash-for-each (lambda (sym advices) (for-each @@ -650,10 +647,7 @@ (let* ([ed (current-qt-editor app)] [echo (app-state-echo app)] [fr (app-state-frame app)] - [lines (list - "Registered Autoloads" - "====================" - "")]) + [lines ("Registered Autoloads" "====================" "")]) (hash-for-each (lambda (sym path) (set! lines @@ -666,9 +660,7 @@ (set! lines (append (reverse lines) - (list - "" - "Use (qt-autoload! 'symbol \"path.ss\") in ~/.jemacs-init."))) + ("" "Use (qt-autoload! 'symbol \"path.ss\") in ~/.jemacs-init."))) (let* ([text (string-join lines "\n")] [buf (or (buffer-by-name "*Autoloads*") (qt-buffer-create! "*Autoloads*" ed #f))]) @@ -677,7 +669,7 @@ (qt-plain-text-edit-set-text! ed text) (qt-text-document-set-modified! (buffer-doc-pointer buf) #f) (qt-plain-text-edit-set-cursor-position! ed 0)))) - (define *qt-loaded-modules*--cell (vector (list))) + (define *qt-loaded-modules*--cell (vector '())) (def (cmd-load-module app) "Load a module at runtime (Qt)." (let* ([echo (app-state-echo app)] @@ -913,7 +905,7 @@ *qt-embark-target-actions*)] [action-list (if actions-entry (cdr actions-entry) - (list))]) + '())]) (if (null? action-list) (echo-message! echo @@ -1415,7 +1407,7 @@ (let ([n (string->number input)]) (when (and n (> n 0)) (let ([text (string-join - (let loop ([i 1] [acc (list)]) + (let loop ([i 1] [acc '()]) (if (> i n) (reverse acc) (loop @@ -1517,8 +1509,7 @@ (lambda () (let* ([p (open-process (list 'path: "/bin/sh" 'arguments: - (list "-c" cmd-str) - 'stdin-redirection: #t + ("-c" cmd-str) 'stdin-redirection: #t 'stdout-redirection: #t 'stderr-redirection: #t))] [_ (begin @@ -1555,7 +1546,7 @@ (lambda () (let* ([p (open-process (list 'path: "/bin/sh" 'arguments: - (list "-c" cmd-str) 'stdout-redirection: #t + ("-c" cmd-str) 'stdout-redirection: #t 'stderr-redirection: #t))] [output (read-line p #f)]) (when output (qt-insert-at-point! ed output)))))))) @@ -1640,7 +1631,7 @@ words) (let* ([pairs (hash->list freq)] [sorted (sort pairs (lambda (a b) (> (cdr a) (cdr b))))] - [top (let loop ([ls sorted] [n 0] [acc (list)]) + [top (let loop ([ls sorted] [n 0] [acc '()]) (if (or (null? ls) (>= n 30)) (reverse acc) (loop (cdr ls) (+ n 1) (cons (car ls) acc))))] --- a/lib/jerboa-emacs/qt/commands-config.sls +++ b/lib/jerboa-emacs/qt/commands-config.sls @@ -28,7 +28,7 @@ (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name sort sort!) + mutex? mutex-name base64-encode base64-decode sort sort!) (std sugar) (chez-scintilla constants) (std sort) (std srfi srfi-13) (std text base64) (std text diff) (jerboa-emacs qt sci-shim) (jerboa-emacs core) @@ -189,10 +189,10 @@ (lambda () (let* ([proc (open-process (list 'path: "/usr/bin/fc-list" 'arguments: - (list ":spacing=mono" "family") - 'stdin-redirection: #f 'stdout-redirection: #t - 'stderr-redirection: #f))] - [lines (let loop ([acc (list)]) + (":spacing=mono" "family") 'stdin-redirection: + #f 'stdout-redirection: #t 'stderr-redirection: + #f))] + [lines (let loop ([acc '()]) (let ([line (read-line proc)]) (if (eof-object? line) acc @@ -308,9 +308,7 @@ (let* ([fr (app-state-frame app)] [ed (current-qt-editor app)] [buf (qt-buffer-create! "*Colors*" ed #f)] - [lines (let loop ([cs *named-colors*] - [row (list)] - [acc (list)]) + [lines (let loop ([cs *named-colors*] [row '()] [acc '()]) (cond [(null? cs) (reverse @@ -322,7 +320,7 @@ [(= (length row) 4) (loop cs - (list) + '() (cons (string-join (reverse row) " ") acc))] [else (let* ([c (car cs)] @@ -355,7 +353,7 @@ (def (discover-user-themes) "Scan ~/.jemacs-themes/*.ss for user-defined theme files.\n Returns a list of theme names (symbols)." (with-catch - (lambda (e) (list)) + (lambda (e) '()) (lambda () (if (file-exists? *user-themes-dir*) (let* ([files (directory-files *user-themes-dir*)] @@ -368,7 +366,7 @@ (string->symbol (substring f 0 (- (string-length f) 3)))) theme-files)) - (list))))) + '())))) (def (load-user-theme-file! theme-name) "Load a user theme file from ~/.jemacs-themes/THEME-NAME.ss\n Returns #t on success, #f on failure." (with-catch --- a/lib/jerboa-emacs/qt/commands-config2.sls +++ b/lib/jerboa-emacs/qt/commands-config2.sls @@ -222,13 +222,13 @@ (let ([marks (hash-get *dired-marks* buf)] [entries (hash-get *dired-entries* buf)]) (if (and marks entries) - (let loop ([i 0] [acc (list)]) + (let loop ([i 0] [acc '()]) (if (>= i (vector-length entries)) (reverse acc) (if (hash-get marks i) (loop (+ i 1) (cons (vector-ref entries i) acc)) (loop (+ i 1) acc)))) - (list)))) + '()))) (def (cmd-dired-do-delete-marked app) "Delete all marked files in dired (async)." (let* ([buf (current-qt-buffer app)] @@ -389,7 +389,7 @@ (>= idx 0) (< idx (vector-length entries))) (list (vector-ref entries idx)) - (list))) + '())) marked)]) (if (null? files) (echo-message! (app-state-echo app) "No file on this line") @@ -875,7 +875,7 @@ (lambda (e) (echo-error! echo "aspell not available")) (lambda () (let ([proc (open-process - (list 'path: "aspell" 'arguments: (list "pipe") + (list 'path: "aspell" 'arguments: ("pipe") 'stdin-redirection: #t 'stdout-redirection: #t 'stderr-redirection: #t))]) (read-line proc) @@ -998,7 +998,7 @@ (def (cmd-project-switch-project app) "Switch to a different project directory." (let* ([echo (app-state-echo app)] - [buf-roots (let loop ([bs *buffer-list*] [acc (list)]) + [buf-roots (let loop ([bs *buffer-list*] [acc '()]) (if (null? bs) acc (let* ([b (car bs)] @@ -1069,12 +1069,12 @@ (when (and pattern (> (string-length pattern) 0)) (echo-message! echo "Searching...") (let ([output (with-catch - (lambda (e) (list)) + (lambda (e) '()) (lambda () (let* ([proc (open-process (list 'path: "/usr/bin/grep" 'arguments: - (list "-rn" "--include=*.ss" + ("-rn" "--include=*.ss" "--include=*.scm" "--include=*.el" "--include=*.py" @@ -1097,7 +1097,7 @@ root) 'stdout-redirection: #t 'stderr-redirection: #t))] - [lines (let loop ([acc (list)]) + [lines (let loop ([acc '()]) (let ([line (read-line proc)]) (if (eof-object? line) (reverse acc) @@ -1195,7 +1195,7 @@ (lambda () (let* ([proc (open-process (list 'path: "/usr/bin/git" 'arguments: - (list "diff" "--no-color" "-U0" path) + ("diff" "--no-color" "-U0" path) 'stdout-redirection: #t 'stderr-redirection: #t))] [output (let loop ([lines '()]) @@ -1661,8 +1661,8 @@ (lambda () (let ([proc (open-process (list 'path: "ctags" 'arguments: - (list "-R" "-o" tags-path root) - 'stdin-redirection: #f 'stdout-redirection: #t + ("-R" "-o" tags-path root) 'stdin-redirection: + #f 'stdout-redirection: #t 'stderr-redirection: #f))]) (read-line proc #f) (close-port proc)) --- a/lib/jerboa-emacs/qt/commands-core.sls +++ b/lib/jerboa-emacs/qt/commands-core.sls @@ -42,7 +42,7 @@ (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name sort sort!) + mutex? mutex-name base64-encode base64-decode sort sort!) (std sugar) (chez-scintilla constants) (std sort) (std srfi srfi-13) (std text base64) (std text json) (jerboa-emacs qt sci-shim) (jerboa-emacs core) @@ -59,8 +59,8 @@ (only (jerboa-emacs gsh-eshell) gsh-eshell-buffer? gsh-eshell-prompt eshell-history-prev eshell-history-next) (jerboa core) (jerboa runtime)) - (define *winner-history*--cell (vector (list))) - (define *winner-future*--cell (vector (list))) + (define *winner-history*--cell (vector '())) + (define *winner-future*--cell (vector '())) (define *winner-max-history*--cell (vector 50)) (def (winner-snapshot-tree node) "Serialize split tree as an s-expr with buffer names for snapshot." @@ -89,7 +89,7 @@ (apply append (map winner-snapshot-leaf-names (cddr snapshot)))] - [else (list)])) + [else '()])) (def (winner-current-config fr) "Capture current window configuration as (tree-snapshot . cur-buf-name)." (let ([cur-buf (buffer-name @@ -102,7 +102,7 @@ (when (> (length *winner-history*) *winner-max-history*) (set! *winner-history* (take *winner-history* *winner-max-history*))) - (set! *winner-future* (list)))) + (set! *winner-future* '()))) (def (winner-restore-config! app config) "Restore a saved window configuration.\n\n Strategy for UNDO (fewer windows): delete last windows. Since splits always\n append to the end of the flat list, deleting from the end naturally restores\n the correct tree structure — the delete logic handles tree cleanup itself.\n\n Strategy for REDO (more windows): split to create extra windows." (let* ([fr (app-state-frame app)] @@ -286,7 +286,7 @@ (for-each (lambda (buf) (qt-setup-highlighting! app buf)) (buffer-list)))) - (define *buffer-recent*--cell (vector (list))) + (define *buffer-recent*--cell (vector '())) (def (buffer-touch! buf) "Record buffer as most recently used." (let ([name (buffer-name buf)]) @@ -828,7 +828,7 @@ #\newline))) (+ i 1) (loop (- i 1))))]) - (let loop ([i line-start] [acc (list)]) + (let loop ([i line-start] [acc '()]) (if (and (< i text-len) (let ([ch (string-ref text i)]) (or (char=? ch #\space) (char=? ch #\tab)))) @@ -1038,7 +1038,7 @@ (echo-message! (app-state-echo app) "Only one window") (if (= n 2) (qt-frame-other-window! fr) - (let* ([labels (let loop ([ws wins] [i 0] [acc (list)]) + (let* ([labels (let loop ([ws wins] [i 0] [acc '()]) (if (null? ws) (reverse acc) (let* ([w (car ws)] @@ -1158,21 +1158,21 @@ (qt-plain-text-edit-ensure-cursor-visible! ed) (echo-message! echo (string-append "Line " input))) (echo-error! echo "Invalid line number")))))) - (define *mx-command-history*--cell (vector (list))) + (define *mx-command-history*--cell (vector '())) (define *mx-history-max*--cell (vector 50)) (def (qt-mx-history-add! name) "Add a command name to M-x recency list (most recent first, no duplicates).\n Also records in shared frequency-based history." (set! *mx-command-history* (cons name - (let loop ([h *mx-command-history*] [acc (list)]) + (let loop ([h *mx-command-history*] [acc '()]) (cond [(null? h) (reverse acc)] [(string=? (car h) name) (loop (cdr h) acc)] [else (loop (cdr h) (cons (car h) acc))])))) (when (> (length *mx-command-history*) *mx-history-max*) (set! *mx-command-history* - (let loop ([h *mx-command-history*] [n 0] [acc (list)]) + (let loop ([h *mx-command-history*] [n 0] [acc '()]) (if (or (null? h) (>= n *mx-history-max*)) (reverse acc) (loop (cdr h) (+ n 1) (cons (car h) acc)))))) @@ -1185,7 +1185,7 @@ [check-prefix (string (integer->char 10003) #\space)] [pinned-names (let loop ([h *mx-command-history*] [n 0] - [acc (list)]) + [acc '()]) (if (or (null? h) (>= n *mx-recent-pinned-count*)) (reverse acc) @@ -1367,7 +1367,7 @@ [line-text (if (< line (length lines)) (list-ref lines line) "")]) - (let* ([new-lines (let loop ([ls lines] [i 0] [acc (list)]) + (let* ([new-lines (let loop ([ls lines] [i 0] [acc '()]) (if (null? ls) (reverse acc) (if (= i line) --- a/lib/jerboa-emacs/qt/commands-core2.sls +++ b/lib/jerboa-emacs/qt/commands-core2.sls @@ -26,7 +26,7 @@ (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name sort sort!) + mutex? mutex-name base64-encode base64-decode sort sort!) (std sugar) (std sort) (std srfi srfi-13) (std text base64) (std text json) (only (std net uri) uri-encode uri-decode) (jerboa-emacs qt sci-shim) (jerboa-emacs core) @@ -86,7 +86,7 @@ (def (get-or-create-completer! ed app) "Get or create a completer for an editor." (or (hash-get *editor-completers* ed) - (let ([c (qt-completer-create (list))]) + (let ([c (qt-completer-create '())]) (qt-completer-set-case-sensitivity! c #f) (qt-completer-set-widget! c ed) (qt-on-completer-activated! @@ -856,9 +856,7 @@ (when (> (string-length now) 0) (let* ([old-line (list-ref lines clock-line)] [new-line (string-append old-line "--" now)] - [new-lines (let loop ([ls lines] - [i 0] - [acc (list)]) + [new-lines (let loop ([ls lines] [i 0] [acc '()]) (if (null? ls) (reverse acc) (loop @@ -893,7 +891,7 @@ [else (loop (- i 1))]))]) (if (not clock-line) (echo-message! echo "No open clock entry to cancel") - (let* ([new-lines (let loop ([ls lines] [i 0] [acc (list)]) + (let* ([new-lines (let loop ([ls lines] [i 0] [acc '()]) (if (null? ls) (reverse acc) (if (= i clock-line) --- a/lib/jerboa-emacs/qt/commands-edit.sls +++ b/lib/jerboa-emacs/qt/commands-edit.sls @@ -44,7 +44,7 @@ (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name sort sort!) + mutex? mutex-name base64-encode base64-decode sort sort!) (std sugar) (chez-scintilla constants) (std sort) (std srfi srfi-13) (std text base64) (jerboa-emacs qt sci-shim) (jerboa-emacs core) @@ -334,7 +334,7 @@ "Replace a line by index in a Qt editor. Reconstructs the full text." (let* ([text (qt-plain-text-edit-text ed)] [lines (string-split text #\newline)] - [new-lines (let loop ([ls lines] [i 0] [acc (list)]) + [new-lines (let loop ([ls lines] [i 0] [acc '()]) (if (null? ls) (reverse acc) (if (= i line-num) @@ -1477,7 +1477,7 @@ "Parse text with ANSI escape codes into a list of (string fg bg bold?) segments.\nReturns (values clean-text segments) where segments is a list of\n(start-in-clean length fg-color bg-color bold?)." (let* ([len (string-length text)] [clean (open-output-string)] - [segments (list)] + [segments '()] [cur-fg #f] [cur-bg #f] [cur-bold #f] @@ -1503,7 +1503,7 @@ (list seg-start (- clean-pos seg-start) cur-fg cur-bg cur-bold) segments))) - (let param-loop ([j (+ i 2)] [params (list)]) + (let param-loop ([j (+ i 2)] [params '()]) (cond [(>= j len) (loop j clean-pos)] [(char=? (string-ref text j) #\m) @@ -1536,7 +1536,7 @@ (vector-ref *ansi-bright-colors* (- code 100)))])) - (if (null? codes) (list 0) codes))) + (if (null? codes) (0) codes))) (set! seg-start clean-pos) (loop (+ j 1) clean-pos)] [(or (char-numeric? (string-ref text j)) --- a/lib/jerboa-emacs/qt/commands-edit2.sls +++ b/lib/jerboa-emacs/qt/commands-edit2.sls @@ -86,7 +86,7 @@ [line (qt-plain-text-edit-cursor-line ed)]) (when (< line (length lines)) (let* ([killed (list-ref lines line)] - [new-lines (let loop ([ls lines] [i 0] [acc (list)]) + [new-lines (let loop ([ls lines] [i 0] [acc '()]) (if (null? ls) (reverse acc) (if (= i line) @@ -124,7 +124,7 @@ (string-trim-right current) " " next)] - [new-lines (let loop ([ls lines] [i 0] [acc (list)]) + [new-lines (let loop ([ls lines] [i 0] [acc '()]) (cond [(null? ls) (reverse acc)] [(= i line) @@ -285,7 +285,7 @@ "")) (+ i 1) (loop (+ i 1))))] - [para-lines (let loop ([i para-start] [acc (list)]) + [para-lines (let loop ([i para-start] [acc '()]) (if (>= i para-end) (reverse acc) (loop @@ -299,7 +299,7 @@ '("") (let loop ([ws (cdr words)] [current-line (car words)] - [acc (list)]) + [acc '()]) (if (null? ws) (reverse (cons current-line acc)) (let ([next (string-append @@ -315,13 +315,13 @@ (cons current-line acc)))))))]) - (let* ([before (let loop ([i 0] [acc (list)]) + (let* ([before (let loop ([i 0] [acc '()]) (if (>= i para-start) (reverse acc) (loop (+ i 1) (cons (list-ref lines i) acc))))] - [after (let loop ([i para-end] [acc (list)]) + [after (let loop ([i para-end] [acc '()]) (if (>= i (length lines)) (reverse acc) (loop @@ -476,7 +476,7 @@ (hash-put! seen w #t)) current-words) (let loop ([bufs (buffer-list)] - [acc (list)]) + [acc '()]) (if (null? bufs) acc (let* ([b (car bufs)] @@ -581,14 +581,14 @@ (loop (+ i 1)) (+ i 1)))] [new-lines (append - (let loop ([i 0] [acc (list)]) + (let loop ([i 0] [acc '()]) (if (>= i start) (reverse acc) (loop (+ i 1) (cons (list-ref lines i) acc)))) '("") - (let loop ([i end] [acc (list)]) + (let loop ([i end] [acc '()]) (if (>= i (length lines)) (reverse acc) (loop @@ -607,13 +607,13 @@ (loop (+ i 1)) i))] [new-lines (append - (let loop ([i 0] [acc (list)]) + (let loop ([i 0] [acc '()]) (if (> i line) (reverse acc) (loop (+ i 1) (cons (list-ref lines i) acc)))) - (let loop ([i end] [acc (list)]) + (let loop ([i end] [acc '()]) (if (>= i (length lines)) (reverse acc) (loop @@ -906,7 +906,7 @@ (let* ([ed (current-qt-editor app)] [text (qt-plain-text-edit-text ed)] [lines (string-split text #\newline)] - [matches (let loop ([ls lines] [i 1] [acc (list)]) + [matches (let loop ([ls lines] [i 1] [acc '()]) (if (null? ls) (reverse acc) (if (string-contains (car ls) query) @@ -1575,7 +1575,7 @@ (list-ref lines (- line 1)))] [curr (string-trim (list-ref lines line))] [joined (string-append prev " " curr)] - [new-lines (let loop ([ls lines] [i 0] [acc (list)]) + [new-lines (let loop ([ls lines] [i 0] [acc '()]) (cond [(null? ls) (reverse acc)] [(= i (- line 1)) @@ -1672,7 +1672,7 @@ occur-text #\newline)] [changes (let loop ([ls occur-lines] - [acc (list)]) + [acc '()]) (if (null? ls) (reverse acc) (let* ([line (car ls)] @@ -1821,7 +1821,7 @@ [text (qt-plain-text-edit-text ed)] [cur-lines (string-split text #\newline)] [orig-vec (hash-get *wdired-originals* name)] - [renames (list)]) + [renames '()]) (let loop ([cur cur-lines] [i 0]) (when (and (not (null? cur)) (< i (vector-length orig-vec))) @@ -1866,11 +1866,7 @@ (lambda (e) #f) (lambda () (run-process - (list - "mv" - "--" - old-f - new-f) + ("mv" "--" old-f new-f) 'stdout-redirection: #f) #t))]) --- a/lib/jerboa-emacs/qt/commands-file.sls +++ b/lib/jerboa-emacs/qt/commands-file.sls @@ -33,7 +33,7 @@ (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name sort sort!) + mutex? mutex-name base64-encode base64-decode sort sort!) (std sugar) (chez-scintilla constants) (std sort) (std srfi srfi-13) (std text base64) (jerboa-emacs qt sci-shim) (jerboa-emacs core) @@ -81,7 +81,7 @@ "Find all positions of CH in TEXT between START and END." (let ([len (min end (string-length text))] [target (char-downcase ch)]) - (let loop ([i start] [acc (list)]) + (let loop ([i start] [acc '()]) (if (>= i len) (reverse acc) (if (char=? (char-downcase (string-ref text i)) target) @@ -90,7 +90,7 @@ (def (avy-find-word-positions text start end) "Find positions at the start of each word in TEXT between START and END." (let ([len (min end (string-length text))]) - (let loop ([i start] [in-word #f] [acc (list)]) + (let loop ([i start] [in-word #f] [acc '()]) (if (>= i len) (reverse acc) (let ([ch (string-ref text i)]) @@ -103,7 +103,7 @@ "Format candidate list with labels for echo display." (let ([labels *avy-labels*] [n (min (string-length *avy-labels*) (length positions))]) - (let loop ([i 0] [ps positions] [acc (list)]) + (let loop ([i 0] [ps positions] [acc '()]) (if (or (>= i n) (null? ps)) (string-join (reverse acc) " ") (let* ([pos (car ps)] @@ -213,7 +213,7 @@ [start (max 0 (- pos 2000))] [end (min (string-length text) (+ pos 2000))] [positions (let loop ([i start] - [acc (if (= start 0) (list 0) (list))]) + [acc (if (= start 0) (0) '())]) (if (>= i end) (reverse acc) (if (char=? (string-ref text i) #\newline) @@ -224,9 +224,7 @@ [(= (length positions) 0) (echo-error! (app-state-echo app) "No lines found")] [else - (let ([labels-str (let loop ([i 0] - [ps positions] - [acc (list)]) + (let ([labels-str (let loop ([i 0] [ps positions] [acc '()]) (if (or (>= i n) (null? ps)) (string-join (reverse acc) " ") (let* ([p (car ps)] @@ -394,7 +392,7 @@ [fr (app-state-frame app)]) (if (null? ring) (echo-message! echo "Kill ring is empty") - (let* ([entries (let loop ([items ring] [i 0] [acc (list)]) + (let* ([entries (let loop ([items ring] [i 0] [acc '()]) (if (or (null? items) (>= i 20)) (reverse acc) (let ([item (car items)]) @@ -428,7 +426,7 @@ [ed (current-qt-editor app)]) (if (null? ring) (echo-message! echo "Kill ring is empty") - (let* ([previews (let loop ([items ring] [i 0] [acc (list)]) + (let* ([previews (let loop ([items ring] [i 0] [acc '()]) (if (or (null? items) (>= i 10)) (reverse acc) (let* ([item (car items)] @@ -484,7 +482,7 @@ (map (lambda (k) (string k)) (hash-keys regs)) string<?)] - [acc (list)]) + [acc '()]) (if (null? keys) (reverse acc) (let* ([key (string-ref (car keys) 0)] @@ -636,7 +634,7 @@ "")) (+ i 1) (loop (+ i 1))))] - [para-lines (let loop ([i para-start] [acc (list)]) + [para-lines (let loop ([i para-start] [acc '()]) (if (>= i para-end) (reverse acc) (loop @@ -645,13 +643,13 @@ (string-trim (list-ref lines i)) acc))))] [joined (string-join para-lines " ")] - [before (let loop ([i 0] [acc (list)]) + [before (let loop ([i 0] [acc '()]) (if (>= i para-start) (reverse acc) (loop (+ i 1) (cons (list-ref lines i) acc))))] - [after (let loop ([i para-end] [acc (list)]) + [after (let loop ([i para-end] [acc '()]) (if (>= i (length lines))