From: Matt Birkholz Date: Fri, 31 Aug 2012 00:38:18 +0000 (-0700) Subject: Added --args and -- option parsers, and a command-line procedure. X-Git-Tag: release-9.2.0~227 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=544915d76aecccd1b7908a333888e5429be6a84c;p=mit-scheme.git Added --args and -- option parsers, and a command-line procedure. --- diff --git a/doc/user-manual/user.texinfo b/doc/user-manual/user.texinfo index 7437860cf..77e59e9f9 100644 --- a/doc/user-manual/user.texinfo +++ b/doc/user-manual/user.texinfo @@ -658,6 +658,27 @@ following it on the command line, up to (but not including) the next argument that starts with a hyphen. The files are loaded in the @code{user-initial-environment}. Unless explicitly handled, errors during loading are silently ignored. + +@noindent +The following options allow arguments to be passed to scripts via the +@code{command-line} procedure. + +@deffn procedure command-line +Returns a list of arguments (strings) gathered from the command-line +by options like @code{--args} or @code{--}. +@end deffn + +@item --args @var{argument} @dots{} +@opindex --args +This option causes Scheme to append the @var{argument}s, up +to (but not including) the next argument that starts with a hyphen, to +the list returned by the @bref{command-line} procedure. + +@item -- @var{argument} @dots{} +@opindex -- +This option causes Scheme to append the rest of the command-line +arguments (even those starting with a hyphen) to the list returned by +the @varref{command-line} procedure. @end table @noindent @@ -716,8 +737,14 @@ option that is defined by @var{procedure}. When @var{keyword} is seen, @var{procedure} is called with all of the command-line arguments, starting with @var{keyword}, as a single list argument. @var{Procedure} must return two values (using the @code{values} procedure): the unused -command-line arguments (as a list), and a thunk that is executed to -implement the behavior of the option. +command-line arguments (as a list), and +either @code{#f} or a thunk to invoke after the whole command line has +been parsed (and the init file loaded). Thus @var{procedure} has the option +of executing the appropriate action at parsing time, or delaying it +until after the parsing is complete. The execution of the procedures +(or their associated delayed actions) is strictly left-to-right, +with the init file loaded between the end of parsing and the +delayed actions. @end deffn @node Environment Variables, Starting Scheme from Microsoft Windows, Custom Command-line Options, Running Scheme @@ -1778,7 +1805,7 @@ minutes). @end defvr @defvr variable load-debugging-info-on-demand? -If this variable is @file{#f}, then printing a compiled procedure +If this variable is @code{#f}, then printing a compiled procedure will print the procedure's name only if the debugging information for that procedure is already loaded. Otherwise, it will force loading of the debugging information. diff --git a/src/runtime/load.scm b/src/runtime/load.scm index 2159b1904..877c97116 100644 --- a/src/runtime/load.scm +++ b/src/runtime/load.scm @@ -456,6 +456,11 @@ USA. (define *command-line-parsers*) (define *load-init-file?*) +(define (command-line) + *command-line*) + +(define *command-line* '()) + (define hook/process-command-line) (define (default/process-command-line unused-command-line) (let ((after-parsing-actions '())) @@ -512,10 +517,7 @@ USA. (define (option-keyword? argument) (and (fix:> (string-length argument) 1) - (char=? #\- (string-ref argument 0)) - (or (not (char=? #\- (string-ref argument 1))) - (and (fix:> (string-length argument) 2) - (not (char=? #\- (string-ref argument 2))))))) + (char=? #\- (string-ref argument 0)))) (define (load-init-file) (let ((pathname (init-file-pathname))) @@ -523,24 +525,6 @@ USA. (load pathname user-initial-environment))) unspecific) -;; KEYWORD must be a string with at least one character. For -;; backwards compatibility, the string may have a leading hyphen, -;; which is stripped. -;; -;; PROC is a procedure of one argument. It will be invoked on the -;; list of command line elements extending to the right of the keyword -;; (and including it). -;; -;; PROC returns two values: the sublist starting with the first -;; non-handled command-line element (typically the next keyword), and -;; either #F or a procedure to invoke after the whole command line has -;; been parsed (and the init file loaded). Thus PROC has the option -;; of executing the appropriate action at parsing time, or delaying it -;; until after the parsing is complete. The execution of the PROCs -;; (or their associated delayed actions) is strictly left-to-right, -;; with the init file loaded between the end of parsing and the -;; delayed actions. - (define (set-command-line-parser! keyword proc #!optional description) (guarantee-string keyword 'SET-COMMAND-LINE-PARSER!) (let ((keyword (strip-leading-hyphens keyword)) @@ -549,8 +533,7 @@ USA. (begin (guarantee-string description 'SET-COMMAND-LINE-PARSER!) description)))) - (if (string-null? keyword) - (error:bad-range-argument keyword 'SET-COMMAND-LINE-PARSER!)) + (let ((place (assoc keyword *command-line-parsers*))) (if place (begin @@ -634,6 +617,24 @@ USA. (loop (cdr command-line) (cons next accum)))) (end '() accum))))) +(define (collect-args command-line) + + (define-integrable (end unused args) + (set! *command-line* (append! *command-line* (reverse! args))) + (values unused #f)) + + (let loop ((unused (cdr command-line)) (args '())) + (if (pair? unused) + (let ((next (car unused))) + (if (option-keyword? next) + (end unused args) + (loop (cdr unused) (cons next args)))) + (end unused args)))) + +(define (collect-remaining-args command-line) + (set! *command-line* (append! *command-line* (cdr command-line))) + (values '() #f)) + (define (show-command-line-options) (write-string " @@ -690,4 +691,17 @@ ADDITIONAL OPTIONS supported by this band:\n") repl))))) "Evaluates the argument expressions as if in the REPL.") (simple-command-line-parser "help" show-command-line-options #f) - (simple-command-line-parser "version" (lambda () (%exit 0)) #f)) \ No newline at end of file + (simple-command-line-parser "version" (lambda () (%exit 0)) #f) + (set-command-line-parser! + "args" collect-args + (command-line-option-description + "--args ARG ..." + '("Appends ARGs (up to the next keyword) to the list (command-line).") + 'initialize-command-line-parsers)) + (set-command-line-parser! + "" collect-remaining-args + (command-line-option-description + "-- ARG ..." + '("Appends all ARGs (to the end of the command-line) to the list" + "(command-line).") + 'initialize-command-line-parsers))) \ No newline at end of file diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 2e64aa00a..1a5d97d88 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -2732,6 +2732,7 @@ USA. (load-noisily load) argument-command-line-parser built-in-object-file + command-line condition-type:not-loading current-eval-unit current-load-environment