fixes
ober
11a2af1a1b3fba751d4b60d778c11e9f79dd8b51
--- a/docs/extras.md +++ b/docs/extras.md @@ -495,6 +495,13 @@ A command reports “not available in this build”: appear. - For native features, inspect the build log for a missing library or symbol. +Codex or another color-aware CLI prints black-and-white output: + +- Check `env | grep '^NO_COLOR='` inside `jsh-extras`. `NO_COLOR` is inherited + from the parent environment and most CLIs disable ANSI color whenever it is + present. Run that command with `NO_COLOR` unset, or use the CLI's own explicit + color option when available. + Files appear unchanged after rebuilding: - Remove stale generated/compiled artifacts in the extras checkout before --- a/jsh.ss +++ b/jsh.ss @@ -6,7 +6,12 @@ (except (jsh builtins) list-head) (jsh registry)) +(define *jsh-enabled-features* '()) +(define *jsh-enabled-feature-commands* '()) + (*jsh-tier* "shell") +(*jsh-enabled-feature-manifest* *jsh-enabled-features*) +(*jsh-enabled-feature-commands-manifest* *jsh-enabled-feature-commands*) (let () special-builtin? (void)) (define (get-real-args) --- a/main.ss +++ b/main.ss @@ -158,6 +158,15 @@ ;; Set the trap processing callback for between-command signal handling (*process-traps-fn* (lambda (env) (process-traps! env))) + ;; ,use — load a Jerboa source file into the interactive evaluation env. + (meta-register! + "use" + (lambda (args) + (let ([result (handle-use-command args)]) + (let ([text (format-jerboa-result result)]) + (cons (if (string=? text "") "" (string-append text "\n")) 0)))) + "load a Jerboa source file") + ;; source / . — source a file into the current environment (let ([source-handler (lambda (args env) @@ -567,15 +576,7 @@ (def (execute-comma-input input env) (let ([expr (string-trim-whitespace (substring input 1 (string-length input)))]) - (cond - [(string-prefix? "use " expr) - (let ([result (handle-use-command (substring expr 4 (string-length expr)))]) - (let ([text (format-jerboa-result result)]) - (unless (string=? text "") (displayln text))) - 0)] - [else - (fprintf (current-error-port) "jsh: unknown meta-command: ,~a~n" expr) - 1]))) + (execute-meta-command expr))) (def (execute-input input env) ;; Parse and execute a line of input --- a/registry.ss +++ b/registry.ss @@ -43,3 +43,156 @@ (def (complete-list-specs) (sort! (hash-keys *complete-specs*) string<?)) + +;;; --- Meta-command registry (,commands) --- +;;; Optional packages register handlers here at module load time. +;;; Handler signature: (lambda (args-string) => (cons output-string exit-code)) + +(def *meta-commands* (make-hash-table)) +(def *meta-complete-handlers* (make-hash-table)) +(def *jsh-enabled-feature-manifest* (make-parameter '())) +(def *jsh-enabled-feature-commands-manifest* (make-parameter '())) + +(def (meta-register! name handler description) + (hash-put! *meta-commands* name (cons handler description))) + +(def (meta-complete-register! name handler) + (hash-put! *meta-complete-handlers* name handler)) + +(def (meta-lookup name) + (let ([entry (hash-get *meta-commands* name)]) + (and entry (car entry)))) + +(def (meta-complete-lookup name) + (hash-get *meta-complete-handlers* name)) + +(def (meta-list) + (sort! (hash-keys *meta-commands*) string<?)) + +(def (meta-description name) + (let ([entry (hash-get *meta-commands* name)]) + (if entry (cdr entry) ""))) + +(def (meta-trim str) + (let* ([len (string-length str)] + [start (let loop ([i 0]) + (if (and (< i len) (char-whitespace? (string-ref str i))) + (loop (+ i 1)) + i))] + [end (let loop ([i (- len 1)]) + (if (and (>= i start) (char-whitespace? (string-ref str i))) + (loop (- i 1)) + (+ i 1)))]) + (substring str start end))) + +(def (meta-command-name expr-str) + (let* ([s (meta-trim expr-str)] + [n (string-length s)]) + (let loop ([i 0]) + (cond + [(>= i n) s] + [(char-whitespace? (string-ref s i)) (substring s 0 i)] + [else (loop (+ i 1))])))) + +(def (meta-command-rest expr-str name) + (let* ([s (meta-trim expr-str)] + [n (string-length name)] + [m (string-length s)]) + (if (>= m n) + (meta-trim (substring s n m)) + ""))) + +(def (display-comma-command-list cmds) + (let loop ([xs cmds] [first? #t]) + (cond + [(null? xs) (newline)] + [else + (unless first? (display " ")) + (display ",") + (display (car xs)) + (loop (cdr xs) #f)]))) + +(def (display-enabled-feature-summary!) + (let ([features (*jsh-enabled-feature-manifest*)] + [commands (*jsh-enabled-feature-commands-manifest*)]) + (if (null? features) + (display "Features: base (core shell only)\n") + (begin + (display "Features built into this binary:\n") + (for-each + (lambda (f) + (let ([name (if (pair? f) (car f) f)] + [desc (if (pair? f) (cdr f) "")]) + (if (string=? desc "") + (printf " ~a\n" name) + (printf " ~a - ~a\n" name desc)))) + features))) + (display "Optional meta-commands: ") + (if (null? commands) + (display "none\n") + (display-comma-command-list commands)) + (display "Use ,help to list the commands available in this binary.\n"))) + +(def (jsh-help-lines) + (append + '("jsh meta-commands:" + " ,help ,h ,? show this help" + " ,features show compiled features and optional commands" + " ,use <file.ss> load a Jerboa source file") + (let ([commands (*jsh-enabled-feature-commands-manifest*)]) + (if (null? commands) + '() + (append + '("" + "optional meta-commands compiled into this binary:") + (map (lambda (cmd) (string-append " ," cmd)) commands)))) + (let ([registered (meta-list)]) + (if (null? registered) + '() + (append + '("" + "registered meta-command handlers:") + (map (lambda (cmd) + (let ([desc (meta-description cmd)]) + (if (string=? desc "") + (string-append " ," cmd) + (string-append " ," cmd " " desc)))) + registered)))))) + +(def (display-jsh-help!) + (for-each + (lambda (line) + (display line) + (newline)) + (jsh-help-lines))) + +(def (display-meta-result result) + (when (and (pair? result) (string? (car result)) (not (string=? (car result) ""))) + (display (car result))) + (cond + [(and (pair? result) (number? (cdr result))) (cdr result)] + [(number? result) result] + [else 0])) + +(def (unknown-meta-command expr-str) + (let ([name (meta-command-name expr-str)]) + (fprintf (current-error-port) + "jsh: unknown meta-command: ,~a (try ,help)\n" + name) + 1)) + +(def (execute-meta-command expr-str) + (let* ([expr (meta-trim expr-str)] + [name (meta-command-name expr)]) + (cond + [(or (string=? name "help") (string=? name "h") (string=? name "?")) + (display-jsh-help!) + 0] + [(string=? name "features") + (display-enabled-feature-summary!) + 0] + [(meta-lookup name) + => (lambda (handler) + (display-meta-result + (handler (meta-command-rest expr name))))] + [else (unknown-meta-command expr)]))) --- a/script.ss +++ b/script.ss @@ -94,6 +94,21 @@ status (let ((shell-input (string-join (reverse shell-buffer) "\n"))) (execute-shell-lines shell-input env interactive? status)))) + ;; Comma meta-command line - execute pending shell input first, then + ;; dispatch through the shared meta-command registry. + ((and (> (string-length (car remaining-lines)) 0) + (char=? (string-ref (car remaining-lines) 0) #\,)) + (let* ((pending-status + (if (null? shell-buffer) + status + (let ((shell-input (string-join (reverse shell-buffer) "\n"))) + (execute-shell-lines shell-input env interactive? status)))) + (line (car remaining-lines)) + (meta-status + (execute-meta-command + (substring line 1 (string-length line))))) + (env-set-last-status! env meta-status) + (line-loop (cdr remaining-lines) meta-status '()))) ;; Regular shell line - accumulate (else (line-loop (cdr remaining-lines) status (cons (car remaining-lines) shell-buffer))))))) --- a/test/test-binary.sh +++ b/test/test-binary.sh @@ -48,6 +48,24 @@ check "subshell" "inner" -c "(echo inner)" check_rc "false status" 1 -c "false" check_rc "syntax error status" 2 -c "if" +got="$(printf ',help\n' | "$BINARY" 2>&1)" +rc=$? +if [ "$rc" -eq 0 ] && printf '%s\n' "$got" | grep -Fq "jsh meta-commands:"; then + pass=$((pass + 1)) +else + fail=$((fail + 1)) + printf 'FAIL: ,help via stdin\n rc=%s\n got=%s\n' "$rc" "$got" +fi + +got="$("$BINARY" -c ',features' 2>&1)" +rc=$? +if [ "$rc" -eq 0 ] && printf '%s\n' "$got" | grep -Fq "Features:"; then + pass=$((pass + 1)) +else + fail=$((fail + 1)) + printf 'FAIL: ,features via -c\n rc=%s\n got=%s\n' "$rc" "$got" +fi + use_tmp="$(mktemp -d "${TMPDIR:-/tmp}/jsh-use-test.XXXXXX")" cat > "$use_tmp/use-smoke.ss" <<'EOF' (import (jerboa prelude))