Add embeddable jsh library module
ober
28491a275351c0f41ea7520428b3626655464071
--- a/Makefile +++ b/Makefile @@ -87,7 +87,7 @@ else endif SHELL_MODULES = ast registry macros pregexp-compat util environment lexer arithmetic glob fuzzy \ history parser functions signals expander redirect control jobs builtins \ - pipeline executor completion prompt lineedit script startup main + pipeline executor completion prompt lineedit script startup main lib OILS_DIR := vendor/oils OILS_REPOSITORY ?= https://github.com/ober/oils-jsh-tests.git @@ -252,8 +252,8 @@ jerboa: ensure-jerboa-tools @rm -rf jsh-src @mkdir -p jsh-src/jsh @for m in $(SHELL_MODULES); do cp "$$m.ss" "jsh-src/jsh/$$m.ss"; done - $(JERBUILD) exec --libdirs "$(JH)/lib" support/jerbuild.ss jsh-src src --force - $(JERBUILD) exec --libdirs "$(JH)/lib" support/jerbuild.ss jerboa-src/src src --force + $(SCHEME) --libdirs "$(JH)/lib" --script support/jerbuild.ss jsh-src src --force + $(SCHEME) --libdirs "$(JH)/lib" --script support/jerbuild.ss jerboa-src/src src --force jsh-macos: ensure-jerboa-tools ffi-shim-symbols.list jerboa @case "$(UNAME_S)" in Darwin) ;; *) echo "ERROR: jsh-macos must be built on macOS" >&2; exit 1 ;; esac new file mode 100644 --- /dev/null +++ b/lib.ss @@ -0,0 +1,154 @@ +;;; lib.ss -- embeddable jsh API. + +(export jsh-init! + jsh-run + jsh-capture + jsh-execute-input + jsh-process-traps! + jsh-run-interactive! + gsh-init! + gsh-run + gsh-capture + gsh-execute-input + gsh-process-traps!) + +(import :std/sugar + :std/format + (only-in :std/misc/string string-contains) + (only-in :jsh/util find-file-in-path) + (only-in :jsh/environment + *arith-eval-fn* *execute-input* *gambit-scheduler-rfd* + *gambit-scheduler-wfd* *interactive-shell* + *pipeline-stdin-fd* *pipeline-stdout-fd* *process-traps-fn* + env-get env-init! env-set! env-set-last-status! + env-set-positional! env-shopt-set! make-shell-environment + shell-environment-last-status shell-environment-positional + shell-environment-positional-set!) + (only-in :jsh/executor execute-external) + (only-in :jsh/expander command-substitute) + (only-in :jsh/registry builtin-register!) + (only-in :jsh/builtins *execute-external-fn*) + (only-in :jsh/signals pending-signals! setup-default-signal-handlers! + setup-noninteractive-signal-handlers! trap-get) + (only-in :jsh/jobs job-count job-notify! job-update-status!) + (only-in :jsh/script execute-string source-file!) + (only-in :jsh/arithmetic arith-eval) + (only-in :jsh/ffi ffi-gambit-scheduler-rfd ffi-gambit-scheduler-wfd + ffi-move-gambit-fds) + (only-in :jsh/history history-add! history-count) + (only-in :jsh/prompt expand-prompt) + (only-in :jsh/lineedit detect-terminal-columns line-edit + set-terminal-columns!) + (only-in :jsh/completion complete-word)) + +(def (register-source-builtins! env) + (let ([source-handler + (lambda (args env) + (let ([args (if (and (pair? args) (string=? (car args) "--")) + (cdr args) + args)]) + (if (null? args) + (begin + (fprintf (current-error-port) "jsh: source: filename argument required~n") + 2) + (let* ([filename (car args)] + [filepath (if (string-contains filename "/") + filename + (or (find-file-in-path filename (env-get env "PATH")) + filename))]) + (if (pair? (cdr args)) + (let ([saved-pos (shell-environment-positional env)]) + (env-set-positional! env (cdr args)) + (let ([result (source-file! filepath env)]) + (shell-environment-positional-set! env saved-pos) + result)) + (source-file! filepath))))))]) + (builtin-register! "source" source-handler) + (builtin-register! "." source-handler))) + +(def (jsh-process-traps! env) + (let ([signals (pending-signals!)]) + (for-each + (lambda (sig-name) + (cond + ((string=? sig-name "CHLD") + (job-update-status!) + (job-notify!)) + ((string=? sig-name "WINCH") + (set-terminal-columns! (detect-terminal-columns))) + (else (void))) + (let ([action (trap-get sig-name)]) + (when (and action (string? action)) + (let ([saved-status (shell-environment-last-status env)]) + (jsh-execute-input action env) + (env-set-last-status! env saved-status))))) + signals))) + +(def (jsh-init! . opts) + (let ([interactive? (if (null? opts) #f (car opts))] + [manage-fds? (if (or (null? opts) (null? (cdr opts))) #f (cadr opts))] + [manage-signals? (if (or (null? opts) (null? (cdr opts)) (null? (cddr opts))) #f (caddr opts))]) + (when manage-fds? + (ffi-move-gambit-fds 255)) + (*gambit-scheduler-rfd* (ffi-gambit-scheduler-rfd)) + (*gambit-scheduler-wfd* (ffi-gambit-scheduler-wfd)) + (let ([env (make-shell-environment)]) + (env-init! env) + (env-set! env "SHELL" "gsh") + (env-set! env "JSH_VERSION" (or (getenv "JSH_VERSION" #f) "0.2.0")) + (env-set! env "JSH_VERSION_SHORT" (or (getenv "JSH_VERSION_SHORT" #f) "0.2")) + (*execute-input* (lambda (input env) (execute-string input env))) + (*arith-eval-fn* arith-eval) + (*execute-external-fn* execute-external) + (*process-traps-fn* (lambda (env) (jsh-process-traps! env))) + (register-source-builtins! env) + (when manage-signals? + (if interactive? + (setup-default-signal-handlers!) + (setup-noninteractive-signal-handlers!))) + (when interactive? + (*interactive-shell* #t) + (env-shopt-set! env "expand_aliases" #t)) + env))) + +(def (jsh-execute-input input env) + (let ([status (execute-string input env)]) + (env-set-last-status! env status) + status)) + +(def (jsh-run input env) + (jsh-execute-input input env)) + +(def (jsh-capture input env) + (let ([output (command-substitute input env)]) + (values output (shell-environment-last-status env)))) + +(def (jsh-run-interactive! env tty-fd in-port out-port) + (parameterize ([current-input-port in-port] + [current-output-port out-port] + [current-error-port out-port] + [*pipeline-stdin-fd* tty-fd] + [*pipeline-stdout-fd* tty-fd]) + (let loop ([cmd-num 1]) + (let* ([ps1 (or (env-get env "PS1") "$ ")] + [prompt-str (expand-prompt ps1 + (lambda (name) (env-get env name)) + (job-count) + cmd-num + (history-count) + (lambda (cmd) ""))] + [complete-fn (lambda (line cursor) (complete-word line cursor env))] + [input (with-catch (lambda (e) 'eof) + (lambda () (line-edit prompt-str complete-fn 'emacs)))]) + (unless (eq? input 'eof) + (unless (string=? input "") + (history-add! input) + (env-set-last-status! env (jsh-execute-input input env)) + (jsh-process-traps! env)) + (loop (+ cmd-num 1))))))) + +(def gsh-init! jsh-init!) +(def gsh-run jsh-run) +(def gsh-capture jsh-capture) +(def gsh-execute-input jsh-execute-input) +(def gsh-process-traps! jsh-process-traps!)