cs: fill in missing command-line flags
This commit is contained in:
Matthew Flatt
parent
c628414d6c
commit
33d7840a93
|
|
@ -73,7 +73,7 @@ run-wpo: $(BUILDDIR)racket.so ../../bin/racket
|
|||
$(BUILDDIR)racket.so: $(BUILDDIR)main.so $(COMPILE_FILE_DEPS)
|
||||
$(COMPILE_FILE) --whole-program $(BUILDDIR)racket.so $(BUILDDIR)main.wpo
|
||||
|
||||
$(BUILDDIR)main.so: $(MAIN_DEPS) main.sps $(COMPILE_FILE_DEPS)
|
||||
$(BUILDDIR)main.so: $(MAIN_DEPS) main.sps main/help.ss $(COMPILE_FILE_DEPS)
|
||||
$(COMPILE_FILE) main.sps $(MAIN_DEPS)
|
||||
|
||||
strip:
|
||||
|
|
|
|||
|
|
@ -74,6 +74,30 @@ static ptr Sbytevector(char *s)
|
|||
return bv;
|
||||
}
|
||||
|
||||
static ptr parse_coldirs(char *s)
|
||||
{
|
||||
iptr len = strlen(s);
|
||||
|
||||
if (!len || !s[len+1]) {
|
||||
/* empty string or only one string */
|
||||
return Sbytevector(s);
|
||||
}
|
||||
|
||||
/* multiple collects paths; put into a reversed list */
|
||||
{
|
||||
ptr rev = Snil;
|
||||
iptr delta = 0;
|
||||
|
||||
while (s[delta]) {
|
||||
len = strlen(s + delta);
|
||||
rev = Scons(Sbytevector(s+delta), rev);
|
||||
delta += len + 1;
|
||||
}
|
||||
|
||||
return rev;
|
||||
}
|
||||
}
|
||||
|
||||
static void racket_exit(int v)
|
||||
{
|
||||
exit(v);
|
||||
|
|
@ -164,7 +188,7 @@ void racket_boot(int argc, char **argv, char *exec_file, char *run_file,
|
|||
sprintf(segment_offset_s, "%ld", segment_offset);
|
||||
l = Scons(Sbytevector(segment_offset_s), l);
|
||||
l = Scons(Sbytevector(configdir), l);
|
||||
l = Scons(Sbytevector(coldir), l);
|
||||
l = Scons(parse_coldirs(coldir), l);
|
||||
l = Scons(Sbytevector(run_file), l);
|
||||
l = Scons(Sbytevector(exec_file), l);
|
||||
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@
|
|||
current-library-collection-paths
|
||||
find-library-collection-paths
|
||||
use-collection-link-paths
|
||||
current-compiled-file-roots
|
||||
find-main-config
|
||||
executable-yield-handler
|
||||
load-on-demand-enabled
|
||||
|
|
@ -22,6 +23,7 @@
|
|||
dynamic-require
|
||||
namespace-require
|
||||
embedded-load
|
||||
module-path?
|
||||
module-declared?
|
||||
module->language-info
|
||||
module-path-index-join
|
||||
|
|
@ -32,7 +34,8 @@
|
|||
version
|
||||
exit
|
||||
compile-keep-source-locations!
|
||||
expander-place-init!)
|
||||
expander-place-init!
|
||||
path-list-string->path-list)
|
||||
(regexp)
|
||||
(io)
|
||||
(thread)
|
||||
|
|
@ -55,11 +58,24 @@
|
|||
(bytes->string/locale s #\?)
|
||||
s))
|
||||
the-command-line-arguments/maybe-bytes))
|
||||
(define (find-original-bytes s)
|
||||
;; In case `the-command-line-arguments/maybe-bytes` has bytes,
|
||||
;; try to get the original byte string for `s`
|
||||
(let loop ([args the-command-line-arguments]
|
||||
[args/maybe-bytes the-command-line-arguments/maybe-bytes])
|
||||
(cond
|
||||
[(null? args) s]
|
||||
[(eq? (car args) s) (car args/maybe-bytes)]
|
||||
[else (loop (cdr args) (cdr args/maybe-bytes))])))
|
||||
(define (->path s)
|
||||
(cond
|
||||
[(path? s) s]
|
||||
[(bytes? s) (bytes->path s)]
|
||||
[else (string->path s)]))
|
||||
|
||||
(define (getenv-bytes str)
|
||||
(environment-variables-ref (|#%app| current-environment-variables) (string->utf8 str)))
|
||||
|
||||
(define builtin-argc 9)
|
||||
(seq
|
||||
(unless (>= (length the-command-line-arguments) builtin-argc)
|
||||
|
|
@ -70,12 +86,17 @@
|
|||
" to start")))
|
||||
(set-exec-file! (->path (list-ref the-command-line-arguments/maybe-bytes 0)))
|
||||
(set-run-file! (->path (list-ref the-command-line-arguments/maybe-bytes 1))))
|
||||
(define init-collects-dir (let ([s (list-ref the-command-line-arguments/maybe-bytes 2)])
|
||||
(if (or (equal? s "")
|
||||
(equal? s '#vu8()))
|
||||
'disable
|
||||
(->path s))))
|
||||
(define init-config-dir (->path (or (getenv "PLTCONFIGDIR")
|
||||
(define-values (init-collects-dir collects-pre-extra)
|
||||
(let ([s (list-ref the-command-line-arguments/maybe-bytes 2)])
|
||||
(cond
|
||||
[(or (equal? s "")
|
||||
(equal? s '#vu8()))
|
||||
(values 'disable '())]
|
||||
[(or (string? s) (bytevector? s)) (values (->path s) '())]
|
||||
[else (let ([s (reverse s)])
|
||||
(values (->path (car s))
|
||||
(map ->path (cdr s))))])))
|
||||
(define init-config-dir (->path (or (getenv-bytes "PLTCONFIGDIR")
|
||||
(list-ref the-command-line-arguments/maybe-bytes 3))))
|
||||
(define segment-offset (#%string->number (list-ref the-command-line-arguments 4)))
|
||||
(define cs-compiled-subdir? (string=? "true" (list-ref the-command-line-arguments 5)))
|
||||
|
|
@ -104,22 +125,23 @@
|
|||
(ptr-add #f (#%string->number gracket-guid-or-x11-args 16))))))
|
||||
|
||||
(define compiled-file-paths
|
||||
(list (string->path (cond
|
||||
[cs-compiled-subdir?
|
||||
(string-append "compiled/"
|
||||
(cond
|
||||
[(getenv "PLT_ZO_PATH")
|
||||
=> (lambda (s)
|
||||
(unless (and (not (equal? s ""))
|
||||
(relative-path? s))
|
||||
(error 'racket "PLT_ZO_PATH environment variable is not a valid path"))
|
||||
s)]
|
||||
[platform-independent-zo-mode? "cs"]
|
||||
[else (symbol->string (machine-type))]))]
|
||||
[else "compiled"]))))
|
||||
(list (->path (cond
|
||||
[cs-compiled-subdir?
|
||||
(build-path "compiled"
|
||||
(cond
|
||||
[(getenv-bytes "PLT_ZO_PATH")
|
||||
=> (lambda (s)
|
||||
(unless (and (not (equal? s #vu8()))
|
||||
(relative-path? (->path s)))
|
||||
(error 'racket "PLT_ZO_PATH environment variable is not a valid path"))
|
||||
(->path s))]
|
||||
[platform-independent-zo-mode? "cs"]
|
||||
[else (symbol->string (machine-type))]))]
|
||||
[else "compiled"]))))
|
||||
(define user-specific-search-paths? #t)
|
||||
(define load-on-demand? #t)
|
||||
(define compile-machine-independent? (getenv "PLT_COMPILE_ANY"))
|
||||
(define compiled-roots-path-list-string (getenv "PLTCOMPILEDROOTS"))
|
||||
(define embedded-load-in-places #f)
|
||||
|
||||
(define (see saw . args)
|
||||
|
|
@ -215,13 +237,17 @@
|
|||
(define repl? #f)
|
||||
(define repl-init? #t)
|
||||
(define version? #f)
|
||||
(define text-repl? (not gracket?))
|
||||
(define yield? #t)
|
||||
(define stderr-logging-arg #f)
|
||||
(define stdout-logging-arg #f)
|
||||
(define syslog-logging-arg #f)
|
||||
(define runtime-for-init? #t)
|
||||
(define exit-value 0)
|
||||
(define host-collects-dir init-collects-dir)
|
||||
(define host-config-dir init-config-dir)
|
||||
(define addon-dir #f)
|
||||
(define rev-collects-post-extra '())
|
||||
|
||||
(define (no-init! saw)
|
||||
(unless (saw? saw 'top)
|
||||
|
|
@ -248,6 +274,21 @@
|
|||
(format " within: ~a" within-arg)
|
||||
"")))
|
||||
|
||||
(define (no-front!)
|
||||
(unsafe-register-process-global (string->bytes/utf-8 "Racket-GUI-no-front") #vu8(1)))
|
||||
|
||||
(define (add-namespace-require-load! mod-path arg)
|
||||
(unless (module-path? mod-path)
|
||||
(raise-user-error 'require
|
||||
"bad module path: ~V derived from command-line argument: ~a"
|
||||
mod-path
|
||||
arg))
|
||||
(set! loads
|
||||
(cons (lambda () (namespace-require+ mod-path))
|
||||
loads)))
|
||||
|
||||
(include "main/help.ss")
|
||||
|
||||
(define-syntax string-case
|
||||
;; Assumes that `arg` is a variable
|
||||
(syntax-rules ()
|
||||
|
|
@ -277,7 +318,7 @@
|
|||
(list->vector args)))
|
||||
(when (and (null? args) (not (saw? saw 'non-config)))
|
||||
(set! repl? #t)
|
||||
(unless gracket?
|
||||
(when text-repl?
|
||||
(set! version? #t)))]))
|
||||
;; Dispatch on first argument:
|
||||
(if (null? args)
|
||||
|
|
@ -289,47 +330,34 @@
|
|||
arg
|
||||
[("-l" "--lib")
|
||||
(let-values ([(lib-name rest-args) (next-arg "library name" arg within-arg args)])
|
||||
(set! loads
|
||||
(cons
|
||||
(lambda ()
|
||||
(namespace-require+ `(lib ,lib-name)))
|
||||
loads))
|
||||
(add-namespace-require-load! `(lib ,lib-name) lib-name)
|
||||
(no-init! saw)
|
||||
(flags-loop rest-args (see saw 'non-config 'lib)))]
|
||||
[("-t" "--require")
|
||||
(let-values ([(file-name rest-args) (next-arg "file name" arg within-arg args)])
|
||||
(set! loads
|
||||
(cons
|
||||
(lambda ()
|
||||
(namespace-require+ `(file ,file-name)))
|
||||
loads))
|
||||
(add-namespace-require-load! `(file ,file-name) file-name)
|
||||
(no-init! saw)
|
||||
(flags-loop rest-args (see saw 'non-config 'lib)))]
|
||||
[("-p")
|
||||
(let-values ([(package rest-args) (next-arg "package" arg within-arg args)])
|
||||
(add-namespace-require-load! `(planet ,package) package)
|
||||
(no-init! saw)
|
||||
(flags-loop rest-args (see saw 'non-config 'lib)))]
|
||||
[("-u" "--require-script")
|
||||
(let-values ([(file-name rest-args) (next-arg "file name" arg within-arg args)])
|
||||
(set! loads
|
||||
(cons
|
||||
(lambda ()
|
||||
(namespace-require+ `(file ,file-name)))
|
||||
loads))
|
||||
(add-namespace-require-load! `(file ,file-name) file-name)
|
||||
(no-init! saw)
|
||||
(set-run-file! (string->path file-name))
|
||||
(flags-loop (cons "--" rest-args) (see saw 'non-config 'lib)))]
|
||||
[("-f" "--load")
|
||||
(let-values ([(file-name rest-args) (next-arg "file name" arg within-arg args)])
|
||||
(set! loads
|
||||
(cons
|
||||
(lambda ()
|
||||
(load file-name))
|
||||
loads))
|
||||
(set! loads (cons (lambda () (load file-name))
|
||||
loads))
|
||||
(flags-loop rest-args (see saw 'non-config)))]
|
||||
[("-r" "--script")
|
||||
(let-values ([(file-name rest-args) (next-arg "file name" arg within-arg args)])
|
||||
(set! loads
|
||||
(cons
|
||||
(lambda ()
|
||||
(load file-name))
|
||||
loads))
|
||||
(set! loads (cons (lambda () (load file-name))
|
||||
loads))
|
||||
(set-run-file! (string->path file-name))
|
||||
(flags-loop (cons "--" rest-args) (see saw 'non-config)))]
|
||||
[("-e" "--eval")
|
||||
|
|
@ -375,10 +403,8 @@
|
|||
(no-init! saw)
|
||||
(flags-loop rest-args (see saw 'non-config)))]
|
||||
[("-m" "--main")
|
||||
(set! loads
|
||||
(cons
|
||||
(lambda () (call-main))
|
||||
loads))
|
||||
(set! loads (cons (lambda () (call-main))
|
||||
loads))
|
||||
(flags-loop (cdr args) (see saw 'non-config))]
|
||||
[("-i" "--repl")
|
||||
(set! repl? #t)
|
||||
|
|
@ -387,6 +413,10 @@
|
|||
[("-n" "--no-lib")
|
||||
(set! init-library #f)
|
||||
(flags-loop (cdr args) (see saw 'non-config))]
|
||||
[("-V" "--no-yield")
|
||||
(set! yield? #f)
|
||||
(set! version? #t)
|
||||
(flags-loop (cdr args) (see saw 'non-config))]
|
||||
[("-v" "--version")
|
||||
(set! version? #t)
|
||||
(no-init! saw)
|
||||
|
|
@ -401,7 +431,7 @@
|
|||
(loop rest-args))]
|
||||
[("-A" "--addon")
|
||||
(let-values ([(addon-path rest-args) (next-arg "addon directory" arg within-arg args)])
|
||||
(set! addon-dir addon-path)
|
||||
(set! addon-dir (find-original-bytes addon-path))
|
||||
(loop rest-args))]
|
||||
[("-X" "--collects")
|
||||
(let-values ([(collects-path rest-args) (next-arg "collects path" arg within-arg args)])
|
||||
|
|
@ -410,12 +440,17 @@
|
|||
(set! init-collects-dir 'disable)]
|
||||
[else
|
||||
(check-path-arg "collects path" arg within-arg)
|
||||
(set! init-collects-dir (path->complete-path (string->path collects-path)))])
|
||||
(set! init-collects-dir (path->complete-path (->path (find-original-bytes collects-path))))])
|
||||
(loop rest-args))]
|
||||
[("-S" "--search")
|
||||
(let-values ([(collects-path rest-args) (next-arg "path" arg within-arg args)])
|
||||
(check-path-arg "collects path" collects-path within-arg)
|
||||
(set! rev-collects-post-extra (cons (->path (find-original-bytes collects-path)) rev-collects-post-extra))
|
||||
(loop rest-args))]
|
||||
[("-G" "--config")
|
||||
(let-values ([(config-path rest-args) (next-arg "config path" arg within-arg args)])
|
||||
(check-path-arg "config path" arg within-arg)
|
||||
(set! init-config-dir (path->complete-path (string->path config-path)))
|
||||
(check-path-arg "config path" config-path within-arg)
|
||||
(set! init-config-dir (path->complete-path (->path (find-original-bytes config-path))))
|
||||
(loop rest-args))]
|
||||
[("-C" "--cross")
|
||||
(set! host-config-dir init-config-dir)
|
||||
|
|
@ -425,9 +460,15 @@
|
|||
[("-U" "--no-user-path")
|
||||
(set! user-specific-search-paths? #f)
|
||||
(loop (cdr args))]
|
||||
[("-d")
|
||||
[("-R" "--compiled")
|
||||
(let-values ([(paths rest-args) (next-arg "path list" arg within-arg args)])
|
||||
(set! compiled-roots-path-list-string paths)
|
||||
(loop rest-args))]
|
||||
[("-d" "--no-delay")
|
||||
(set! load-on-demand? #t)
|
||||
(loop (cdr args))]
|
||||
[("-b" "--binary")
|
||||
(loop (cdr args))]
|
||||
[("-q" "--no-init-file")
|
||||
(set! repl-init? #f)
|
||||
(loop (cdr args))]
|
||||
|
|
@ -439,6 +480,10 @@
|
|||
(let-values ([(spec rest-args) (next-arg "stdout level" arg within-arg args)])
|
||||
(set! stdout-logging-arg (parse-logging-spec "stdout" spec (format "after ~a switch" (or within-arg arg)) #t))
|
||||
(loop rest-args))]
|
||||
[("-L" "--syslog")
|
||||
(let-values ([(spec rest-args) (next-arg "syslog level" arg within-arg args)])
|
||||
(set! syslog-logging-arg (parse-logging-spec "syslog" spec (format "after ~a switch" (or within-arg arg)) #t))
|
||||
(loop rest-args))]
|
||||
[("-N" "--name")
|
||||
(let-values ([(name rest-args) (next-arg "name" arg within-arg args)])
|
||||
(set-run-file! (string->path name))
|
||||
|
|
@ -452,16 +497,29 @@
|
|||
(loop rest-args))]
|
||||
[else
|
||||
(raise-bad-switch arg within-arg)])]
|
||||
[("-K")
|
||||
[("-K" "--back")
|
||||
(cond
|
||||
[gracket?
|
||||
(unsafe-register-process-global (string->bytes/utf-8 "Racket-GUI-no-front") #vu8(1))
|
||||
(no-front!)
|
||||
(loop (cdr args))]
|
||||
[else
|
||||
(raise-bad-switch arg within-arg)])]
|
||||
[("-z" "--text-repl")
|
||||
(cond
|
||||
[gracket?
|
||||
(no-front!)
|
||||
(set! text-repl? #t)
|
||||
(loop (cdr args))]
|
||||
[else
|
||||
(raise-bad-switch arg within-arg)])]
|
||||
[("-M" "--compile-any")
|
||||
(set! compile-machine-independent? #t)
|
||||
(loop (cdr args))]
|
||||
[("-j" "--no-jit")
|
||||
(loop (cdr args))]
|
||||
[("-h" "--help")
|
||||
(show-help)
|
||||
(exit)]
|
||||
[("--")
|
||||
(cond
|
||||
[(or (null? (cdr args)) (not (pair? (cadr args))))
|
||||
|
|
@ -598,6 +656,13 @@
|
|||
(parse-logging-spec "stdout" spec "in PLTSTDOUT environment variable" #f)
|
||||
'()))))
|
||||
|
||||
(define syslog-logging
|
||||
(or syslog-logging-arg
|
||||
(let ([spec (getenv "PLTSYSLOG")])
|
||||
(if spec
|
||||
(parse-logging-spec "syslog" spec "in PLTSYSLOG environment variable" #f)
|
||||
'()))))
|
||||
|
||||
(define (initialize-place!)
|
||||
(|#%app| current-command-line-arguments remaining-command-line-arguments)
|
||||
(|#%app| use-compiled-file-paths compiled-file-paths)
|
||||
|
|
@ -612,6 +677,9 @@
|
|||
(when (and stdout-logging
|
||||
(not (null? stdout-logging)))
|
||||
(apply add-stdout-log-receiver! (|#%app| current-logger) stdout-logging))
|
||||
(when (and syslog-logging
|
||||
(not (null? syslog-logging)))
|
||||
(apply add-syslog-log-receiver! (|#%app| current-logger) syslog-logging))
|
||||
(cond
|
||||
[(eq? init-collects-dir 'disable)
|
||||
(|#%app| use-collection-link-paths #f)
|
||||
|
|
@ -623,7 +691,13 @@
|
|||
(|#%app| current-library-collection-links
|
||||
(find-library-collection-links))
|
||||
(|#%app| current-library-collection-paths
|
||||
(find-library-collection-paths))))
|
||||
(find-library-collection-paths collects-pre-extra (reverse rev-collects-post-extra))))
|
||||
(when compiled-roots-path-list-string
|
||||
(|#%app| current-compiled-file-roots
|
||||
(let ([s (regexp-replace* "@[(]version[)]"
|
||||
compiled-roots-path-list-string
|
||||
(version))])
|
||||
(path-list-string->path-list s (list (build-path 'same)))))))
|
||||
|
||||
(set-make-place-ports+fds! make-place-ports+fds)
|
||||
|
||||
|
|
@ -641,9 +715,9 @@
|
|||
(f pch)))))
|
||||
|
||||
(let ([a (or addon-dir
|
||||
(getenv "PLTADDONDIR"))])
|
||||
(getenv-bytes "PLTADDONDIR"))])
|
||||
(when a
|
||||
(set-addon-dir! (path->complete-path a))))
|
||||
(set-addon-dir! (path->complete-path (->path a)))))
|
||||
|
||||
(when (getenv "PLT_STATS_ON_BREAK")
|
||||
(keyboard-interrupt-handler
|
||||
|
|
@ -683,13 +757,14 @@
|
|||
(lambda () (dynamic-require m 0))
|
||||
(default-continuation-prompt-tag)
|
||||
(lambda args (set! exit-value 1))))))
|
||||
(|#%app| (if gracket?
|
||||
(dynamic-require 'racket/gui/init 'graphical-read-eval-print-loop)
|
||||
(dynamic-require 'racket/base 'read-eval-print-loop)))
|
||||
(unless gracket?
|
||||
(|#%app| (if text-repl?
|
||||
(dynamic-require 'racket/base 'read-eval-print-loop)
|
||||
(dynamic-require 'racket/gui/init 'graphical-read-eval-print-loop)))
|
||||
(when text-repl?
|
||||
(newline)))
|
||||
|
||||
(|#%app| (|#%app| executable-yield-handler) exit-value)
|
||||
(when yield?
|
||||
(|#%app| (|#%app| executable-yield-handler) exit-value))
|
||||
|
||||
(exit exit-value))))
|
||||
|
||||
|
|
|
|||
87
racket/src/cs/main/help.ss
Normal file
87
racket/src/cs/main/help.ss
Normal file
|
|
@ -0,0 +1,87 @@
|
|||
(define (show-help)
|
||||
(define init-filename
|
||||
(let-values ([(base name dir?) (split-path (find-system-path 'init-file))])
|
||||
(path->string name)))
|
||||
(#%printf "~a: [<option> ...] <argument> ...\n" (if gracket? "gracket" "racket"))
|
||||
(when (and gracket? (eq? 'unix (system-type)))
|
||||
(#%printf
|
||||
(string-append
|
||||
" X configuration options (must precede all other options):\n"
|
||||
" -display <display>, -geometry <geometry>, -fn <font>, -font <font>,\n"
|
||||
" -bg <color>, -background <color>, -fg <color>, -foreground <color>,\n"
|
||||
" -iconic, -name <name>, -rv, -reverse, +rv, -selectionTimeout <timeout>,\n"
|
||||
" -synchronous, -title <title>, -xnllanguage <language>, -xrm <file>\n")))
|
||||
(#%printf
|
||||
(string-append
|
||||
" File and expression options:\n"
|
||||
" -e <exprs>, --eval <exprs> : Evaluate <exprs>, prints results\n"
|
||||
" -f <file>, --load <file> : Like -e '(load \"<file>\")' without printing\n"
|
||||
" -t <file>, --require <file> : Like -e '(require (file \"<file>\"))' [*]\n"
|
||||
" -l <path>, --lib <path> : Like -e '(require (lib \"<path>\"))' [*]\n"
|
||||
" -p <package> : Like -e '(require (planet \"<package>\")' [*]\n"
|
||||
" -r <file>, --script <file> : Same as -f <file> -N <file> --\n"
|
||||
" -u <file>, --require-script <file> : Same as -t <file> -N <file> --\n"
|
||||
" -k <n> <m> <p> : Load executable-embedded code from offset <n> to <p>\n"
|
||||
" -m, --main : Call `main' with command-line arguments, print results\n"
|
||||
" [*] Also `require's a `main' submodule, if any\n"
|
||||
" Interaction options:\n"
|
||||
" -i, --repl : Run interactive read-eval-print loop; implies -v\n"
|
||||
" -n, --no-lib : Skip `(require (lib \"<init-lib>\"))' for -i/-e/-f/-r\n"
|
||||
" -v, --version : Show version\n"))
|
||||
(when gracket?
|
||||
(#%printf
|
||||
(string-append
|
||||
" -K, --back : Don't bring application to the foreground (Mac OS X)\n")))
|
||||
(#%printf
|
||||
(string-append
|
||||
" -V, --no-yield : Skip `((executable-yield-handler) <status>)' on exit\n"
|
||||
" Configuration options:\n"
|
||||
" -c, --no-compiled : Disable loading of compiled files\n"
|
||||
" -q, --no-init-file : Skip load of " init-filename " for -i\n"))
|
||||
(when gracket?
|
||||
(#%printf
|
||||
" -z, --text-repl : Use text `read-eval-print-loop' for -i\n"))
|
||||
(#%printf
|
||||
(string-append
|
||||
" -I <path> : Set <init-lib> to <path> (sets language)\n"
|
||||
" -X <dir>, --collects <dir> : Main collects at <dir> (or \"\" disables all)\n"
|
||||
" -S <dir>, --search <dir> : More collects at <dir> (after main collects)\n"
|
||||
" -G <dir>, --config <dir> : Main configuration directory at <dir>\n"
|
||||
" -A <dir>, --addon <dir> : Addon directory at <dir>\n"
|
||||
" -U, --no-user-path : Ignore user-specific collects, etc.\n"
|
||||
" -R <paths>, --compiled <paths> : Set compiled-file search roots to <paths>\n"
|
||||
" -C, --cross : Cross-build mode; save current collects and config as host\n"
|
||||
" -N <file>, --name <file> : Sets `(find-system-path 'run-file)' to <file>\n"))
|
||||
(when gracket?
|
||||
(#%printf
|
||||
" -J <name>, ---wm-class <name> : Set WM_CLASS class to <name> (Unix)\n"))
|
||||
(#%printf
|
||||
(string-append
|
||||
" -j, --no-jit : No effect, since there is no just-in-time compiler\n"
|
||||
" -M, --compile-any : Compile to machine-independent form\n"
|
||||
" -d, --no-delay : Disable on-demand loading of syntax and code\n"
|
||||
" -b, --binary : No effect, since stdin and stdout/stderr are always binary\n"
|
||||
" -W <levels>, --warn <levels> : Set stderr logging to <levels>\n"
|
||||
" -O <levels>, --stdout <levels> : Set stdout logging to <levels>\n"
|
||||
" -L <levels>, --syslog <levels> : Set syslog logging to <levels>\n"
|
||||
" Meta options:\n"
|
||||
" -- : No argument following this switch is used as a switch\n"
|
||||
" -h, --help : Show this information and exits, ignoring other options\n"
|
||||
"Default options:\n"
|
||||
" If only configuration options are provided, -i is added\n"
|
||||
" If only configuration options are before the first argument, -u is added\n"
|
||||
" If -t/-l/-p/-u apears before the first -i/-e/-f/-r, -n is added\n"
|
||||
" <init-lib> defaults to " (if gracket? "racket/gui/init" "racket/init") "\n"
|
||||
"Switch syntax:\n"
|
||||
" Multiple single-letter switches can be collapsed, with arguments placed\n"
|
||||
" after the collapsed switches; the first collapsed switch cannot be --\n"
|
||||
" Example: `-ifve file expr' is the same as `-i -f file -v -e expr'\n"
|
||||
"Start-up sequence:\n"
|
||||
" 1. Set `current-library-collection-paths'\n"
|
||||
" 2. Require `(lib \"<init-lib>\")' [when -i/-e/-f/-r, unless -n]\n"
|
||||
" 3. Evaluate/load expressions/files in order, until first error\n"
|
||||
" 4. Load \"" init-filename "\" [when -i]\n"
|
||||
" 5. Run read-eval-print loop [when -i]\n"))
|
||||
(when gracket?
|
||||
(#%printf
|
||||
" 6. Run `((executable-yield-handler) <status>)' [unless -V]\n")))
|
||||
|
|
@ -109,6 +109,8 @@
|
|||
resolved-module-path?
|
||||
module-path?
|
||||
|
||||
path-list-string->path-list ; for startup
|
||||
|
||||
declare-primitive-module! ; to support "extensions"
|
||||
|
||||
embedded-load ; for -k
|
||||
|
|
|
|||
|
|
@ -22,6 +22,7 @@
|
|||
make-log-receiver
|
||||
add-stderr-log-receiver!
|
||||
add-stdout-log-receiver!
|
||||
add-syslog-log-receiver!
|
||||
logger-init!)
|
||||
|
||||
(define (make-root-logger)
|
||||
|
|
|
|||
|
|
@ -5,6 +5,8 @@
|
|||
"../host/pthread.rkt"
|
||||
"../host/rktio.rkt"
|
||||
"../string/convert.rkt"
|
||||
"../path/system.rkt"
|
||||
"../path/path.rkt"
|
||||
"level.rkt"
|
||||
"logger.rkt")
|
||||
|
||||
|
|
@ -12,6 +14,7 @@
|
|||
make-log-receiver
|
||||
add-stderr-log-receiver!
|
||||
add-stdout-log-receiver!
|
||||
add-syslog-log-receiver!
|
||||
log-receiver-send!
|
||||
receiver-add-topics)
|
||||
|
||||
|
|
@ -120,7 +123,31 @@
|
|||
|
||||
(define/who (add-stdout-log-receiver! logger . args)
|
||||
(add-stdio-log-receiver! who logger args 'make-stdio-log-receiver RKTIO_STDOUT))
|
||||
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(struct syslog-log-receiver log-receiver (cmd)
|
||||
#:property
|
||||
prop:receiver-send
|
||||
(lambda (lr msg)
|
||||
;; called in atomic mode and possibly in host interrupt handler
|
||||
(define bstr (bytes-append (string->bytes/utf-8 (vector-ref msg 1)) #"\n"))
|
||||
(define pri
|
||||
(case (vector-ref msg 0)
|
||||
[(fatal) RKTIO_LOG_FATAL]
|
||||
[(error) RKTIO_LOG_ERROR]
|
||||
[(warning) RKTIO_LOG_WARNING]
|
||||
[(info) RKTIO_LOG_INFO]
|
||||
[else RKTIO_LOG_DEBUG]))
|
||||
(rktio_syslog rktio pri #f bstr (syslog-log-receiver-cmd lr))))
|
||||
|
||||
(define/who (add-syslog-log-receiver! logger . args)
|
||||
(define lr (syslog-log-receiver (parse-filters 'make-syslog-log-receiver args #:default-level 'none)
|
||||
(path-bytes (find-system-path 'run-file))))
|
||||
(atomically
|
||||
(add-log-receiver! logger lr #f)
|
||||
(set-logger-permanent-receivers! logger (cons lr (logger-permanent-receivers logger)))))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define (add-log-receiver! logger lr backref)
|
||||
|
|
|
|||
|
|
@ -1425,8 +1425,8 @@ static int run_from_cmd_line(int argc, char *_argv[],
|
|||
" -j, --no-jit : No effect, since the just-in-time compiler is unavailable\n"
|
||||
# endif
|
||||
" -M, --compile-any : Compile to machine-independent form\n"
|
||||
" -d, --no-delay: Disable on-demand loading of syntax and code\n"
|
||||
" -b, --binary : Read stdin and write stdout/stderr in binary mode\n"
|
||||
" -d, --no-delay : Disable on-demand loading of syntax and code\n"
|
||||
" -b, --binary : No effect, since stdin and stdout/stderr are always binary\n"
|
||||
" -W <levels>, --warn <levels> : Set stderr logging to <levels>\n"
|
||||
" -O <levels>, --stdout <levels> : Set stdout logging to <levels>\n"
|
||||
" -L <levels>, --syslog <levels> : Set syslog logging to <levels>\n"
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user