dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(ice-9 getopt-long): update commentary and doc-strings

Browse source 
Emphasise importance of predicate part of specification of options with
optional values.  Minor clarifications elsewhere.  Update copyright
years and authorship.

* module/ice-9/getopt-long.scm: Small changes only in non-code parts of
  source file.
This commit is contained in:
Dale Mellor 2020-04-19 18:01:06 +01:00 • committed by Dale
commit fdaff91d01
1 changed files with 371 additions and 190 deletions
Download patch file Download diff file Expand all files Collapse all files

561
module/ice-9/getopt-long.scm
View file

@ -1,5 +1,8 @@
;;; Copyright (C) 1998, 2001, 2006, 2009, 2011 Free Software Foundation, Inc.
;;;
;;;; getopt-long.scm --- long options processing -*- scheme -*-
;;;;
;;;; Copyright (C) 1998, 2001, 2006, 2009, 2011, 2020
;;;; Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
@ -12,54 +15,59 @@
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;;;; 02110-1301 USA
;;; Author: Russ McManus (rewritten by Thien-Thi Nguyen)
;;; Author: Russ McManus
;;; Rewritten by Thien-Thi Nguyen
;;; Rewritten by Dale Mellor 2020-04-14
;;; Commentary:
;;; This module implements some complex command line option parsing, in
;;; the spirit of the GNU C library function `getopt_long'. Both long
;;; the spirit of the GNU C library function ‘getopt_long’. Both long
;;; and short options are supported.
;;;
;;; The theory is that people should be able to constrain the set of
;;; options they want to process using a grammar, rather than some arbitrary
;;; structure. The grammar makes the option descriptions easy to read.
;;; options they want to process using a grammar, rather than some ad
;;; hoc procedure. The grammar makes the option descriptions easy to
;;; read.
;;;
;;; `getopt-long' is a procedure for parsing command-line arguments in a
;;; manner consistent with other GNU programs. `option-ref' is a procedure
;;; that facilitates processing of the `getopt-long' return value.
;;; ‘getopt-long’ is a procedure for parsing command-line arguments in a
;;; manner consistent with other GNU programs. ‘option-ref’ is a procedure
;;; that facilitates processing of the ‘getopt-long’ return value.
;;; (getopt-long ARGS GRAMMAR)
;;; Parse the arguments ARGS according to the argument list grammar GRAMMAR.
;;;
;;; ARGS should be a list of strings. Its first element should be the
;;; name of the program; subsequent elements should be the arguments
;;; name of the program, and subsequent elements should be the arguments
;;; that were passed to the program on the command line. The
;;; `program-arguments' procedure returns a list of this form.
;;; ‘program-arguments’ procedure returns a list of this form.
;;;
;;; GRAMMAR is a list of the form:
;;; ((OPTION (PROPERTY VALUE) ...) ...)
;;;
;;; Each OPTION should be a symbol. `getopt-long' will accept a
;;; command-line option named `--OPTION'.
;;; Each OPTION should be a symbol. ‘getopt-long’ will accept a
;;; command-line option named ‘--OPTION’.
;;; Each option can have the following (PROPERTY VALUE) pairs:
;;;
;;; (single-char CHAR) --- Accept `-CHAR' as a single-character
;;; equivalent to `--OPTION'. This is how to specify traditional
;;; (single-char CHAR) --- Accept ‘-CHAR’ as a single-character
;;; equivalent to ‘--OPTION’. This is how to specify traditional
;;; Unix-style flags.
;;; (required? BOOL) --- If BOOL is true, the option is required.
;;; getopt-long will raise an error if it is not found in ARGS.
;;; (value BOOL) --- If BOOL is #t, the option accepts a value; if
;;; it is #f, it does not; and if it is the symbol
;;; `optional', the option may appear in ARGS with or
;;; ‘optional’, the option may appear in ARGS with or
;;; without a value.
;;; (predicate FUNC) --- If the option accepts a value (i.e. you
;;; specified `(value #t)' for this option), then getopt
;;; will apply FUNC to the value, and throw an exception
;;; if it returns #f. FUNC should be a procedure which
;;; accepts a string and returns a boolean value; you may
;;; need to use quasiquotes to get it into GRAMMAR.
;;; specified ‘(value #t)’ or ‘(value 'optional)’ for this
;;; option), then getopt will apply FUNC to the value, and
;;; will not take the value if it returns #f. FUNC should
;;; be a procedure which accepts a string and returns a
;;; boolean value; you may need to use quasiquotes to get it
;;; into GRAMMAR.
;;;
;;; The (PROPERTY VALUE) pairs may occur in any order, but each
;;; property may occur only once. By default, options do not have
@ -79,16 +87,22 @@
;;; for "blimps" and "catalexis")
;;; ("-ab" "bang" "-c" "couth") (same)
;;; ("-ac" "couth" "-b" "bang") (same)
;;; ("-abc" "couth" "bang") (an error, since `-b' is not the
;;; last option in its combination)
;;;
;;; If an option's value is optional, then `getopt-long' decides
;;; whether it has a value by looking at what follows it in ARGS. If
;;; the next element is does not appear to be an option itself, then
;;; that element is the option's value.
;;; If an option's value is optional, then ‘getopt-long’ decides whether
;;; it has a value by looking at what follows it in ARGS. If the next
;;; element does not appear to be an option itself, and passes a
;;; predicate if given, then that element is taken to be the option's
;;; value. Note that predicate functions are invaluable in this respect
;;; for differentiating options and option values, and in the case of
;;; options with optional values, PREDICATES REALLY SHOULD BE GIVEN. If
;;; an option is supposed to take a numerical value, then
;;; ‘string->number’ can be used as the predicate; this will also allow
;;; negative values to be used, which would ordinarily be regarded as
;;; bad options causing the module, and the application consuming it, to
;;; bail out with an immediate exit to the operating system.
;;;
;;; The value of a long option can appear as the next element in ARGS,
;;; or it can follow the option name, separated by an `=' character.
;;; or it can follow the option name, separated by an ‘=’ character.
;;; Thus, using the same grammar as above, the following argument lists
;;; are equivalent:
;;; ("--apples" "Braeburn" "--blimps" "Goodyear")
@ -99,27 +113,30 @@
;;; subsequent arguments are returned as ordinary arguments, even if
;;; they resemble options. So, in the argument list:
;;; ("--apples" "Granny Smith" "--" "--blimp" "Goodyear")
;;; `getopt-long' will recognize the `apples' option as having the
;;; value "Granny Smith", but it will not recognize the `blimp'
;;; option; it will return the strings "--blimp" and "Goodyear" as
;;; ordinary argument strings.
;;; ‘getopt-long’ will recognize the ‘apples’ option as having the value
;;; "Granny Smith", but it will not recognize the ‘blimp’ option; it
;;; will return the strings "--blimp" and "Goodyear" as ordinary
;;; argument strings. The first "--" argument itself will *not* appear
;;; in the ordinary arguments list, although the occurrence of
;;; subsequent ones will.
;;;
;;; The `getopt-long' function returns the parsed argument list as an
;;; The ‘getopt-long’ function returns the parsed argument list as an
;;; assocation list, mapping option names --- the symbols from GRAMMAR
;;; --- onto their values, or #t if the option does not accept a value.
;;; Unused options do not appear in the alist.
;;;
;;; All arguments that are not the value of any option are returned
;;; as a list, associated with the empty list.
;;; All arguments that are not the value of any option are returned as a
;;; list, associated with the empty list in the above returned
;;; association.
;;;
;;; `getopt-long' throws an exception if:
;;; ‘getopt-long’ throws an exception if:
;;; - it finds an unrecognized property in GRAMMAR
;;; - the value of the `single-char' property is not a character
;;; - the value of the ‘single-char’ property is not a character
;;; - it finds an unrecognized option in ARGS
;;; - a required option is omitted
;;; - an option that requires an argument doesn't get one
;;; - an option that doesn't accept an argument does get one (this can
;;; only happen using the long option `--opt=value' syntax)
;;; only happen using the long option ‘--opt=value’ syntax)
;;; - an option predicate fails
;;;
;;; So, for example:
@ -147,9 +164,10 @@
;;; (option-ref OPTIONS KEY DEFAULT)
;;; Return value in alist OPTIONS using KEY, a symbol; or DEFAULT if not
;;; found. The value is either a string or `#t'.
;;; found. The return is either a string or ‘#t’, or whatever DEFAULT
;;; is.
;;;
;;; For example, using the `getopt-long' return value from above:
;;; For example, using the ‘getopt-long’ return value from above:
;;;
;;; (option-ref (getopt-long ...) 'x-includes 42) => "/usr/include"
;;; (option-ref (getopt-long ...) 'not-a-key! 31) => 31
@ -157,16 +175,15 @@
;;; Code:
(define-module (ice-9 getopt-long)
#:use-module ((ice-9 common-list) #:select (remove-if-not))
#:use-module (ice-9 control)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 optargs)
#:use-module (ice-9 receive)
#:export (getopt-long option-ref))
(define %program-name (make-fluid "guile"))
(define (program-name)
(fluid-ref %program-name))
(define program-name (make-parameter "guile"))
(define (fatal-error fmt . args)
(format (current-error-port) "~a: " (program-name))
@ -174,19 +191,16 @@
(newline (current-error-port))
(exit 1))
;; name: string, required?: bool, single-char: char or #f, predicate:
;; procedure or #f, value-policy: bool or 'optional.
(define-record-type option-spec
(%make-option-spec name required? option-spec->single-char predicate value-policy)
(%make-option-spec name required? single-char predicate value-policy)
option-spec?
(name
option-spec->name set-option-spec-name!)
(required?
option-spec->required? set-option-spec-required?!)
(option-spec->single-char
option-spec->single-char set-option-spec-single-char!)
(predicate
option-spec->predicate set-option-spec-predicate!)
(value-policy
option-spec->value-policy set-option-spec-value-policy!))
(name option-spec->name)
(required? option-spec->required? set-option-spec-required?!)
(single-char option-spec->single-char set-option-spec-single-char!)
(predicate option-spec->predicate set-option-spec-predicate!)
(value-policy option-spec->value-policy set-option-spec-value-policy!))
(define (make-option-spec name)
(%make-option-spec name #f #f #f #f))
@ -194,121 +208,299 @@
(define (parse-option-spec desc)
(let ((spec (make-option-spec (symbol->string (car desc)))))
(for-each (match-lambda
(('required? val)
(set-option-spec-required?! spec val))
(('value val)
(set-option-spec-value-policy! spec val))
(('single-char val)
(or (char? val)
(error "`single-char' value must be a char!"))
(set-option-spec-single-char! spec val))
(('predicate pred)
(set-option-spec-predicate!
spec (lambda (name val)
(or (not val)
(pred val)
(fatal-error "option predicate failed: --~a"
name)))))
((prop val)
(error "invalid getopt-long option property:" prop)))
(cdr desc))
(('required? val)
(set-option-spec-required?! spec val))
(('value val)
(set-option-spec-value-policy! spec val))
(('single-char val)
(unless (char? val)
(fatal-error "‘single-char’ value must be a char!"))
(set-option-spec-single-char! spec val))
(('predicate pred)
(set-option-spec-predicate! spec pred))
((prop val)
(fatal-error "invalid getopt-long option property: " prop)))
(cdr desc))
spec))
(define (split-arg-list argument-list)
;; Scan ARGUMENT-LIST for "--" and return (BEFORE-LS . AFTER-LS).
;; Discard the "--". If no "--" is found, AFTER-LS is empty.
(let loop ((yes '()) (no argument-list))
(cond ((null? no) (cons (reverse yes) no))
((string=? "--" (car no)) (cons (reverse yes) (cdr no)))
(else (loop (cons (car no) yes) (cdr no))))))
(define short-opt-rx (make-regexp "^-([a-zA-Z]+)(.*)"))
(define long-opt-no-value-rx (make-regexp "^--([^=]+)$"))
(define long-opt-with-value-rx (make-regexp "^--([^=]+)=(.*)"))
;; Extract the name of a long option given that it may or may not be
;; surrounded by '--' and '=...'.
(define isolate-long-name-re (make-regexp "^(--)?([^=]+)"))
(define (looks-like-an-option string)
(or (regexp-exec short-opt-rx string)
(regexp-exec long-opt-with-value-rx string)
(regexp-exec long-opt-no-value-rx string)))
(define (isolate-long-name name)
(and=> (regexp-exec isolate-long-name-re name)
(λ (match) (match:substring match 2))))
(define (process-options specs argument-ls stop-at-first-non-option)
;; Use SPECS to scan ARGUMENT-LS; return (FOUND . ETC).
;; FOUND is an unordered list of option specs for found options, while ETC
;; is an order-maintained list of elements in ARGUMENT-LS that are neither
;; options nor their values.
(let ((idx (map (lambda (spec)
(cons (option-spec->name spec) spec))
specs))
(sc-idx (map (lambda (spec)
(cons (make-string 1 (option-spec->single-char spec))
spec))
(remove-if-not option-spec->single-char specs))))
(let loop ((unclumped 0) (argument-ls argument-ls) (found '()) (etc '()))
(define (eat! spec ls)
(cond
((eq? 'optional (option-spec->value-policy spec))
(if (or (null? ls)
(looks-like-an-option (car ls)))
(loop (- unclumped 1) ls (acons spec #t found) etc)
(loop (- unclumped 2) (cdr ls) (acons spec (car ls) found) etc)))
((eq? #t (option-spec->value-policy spec))
(if (or (null? ls)
(looks-like-an-option (car ls)))
(fatal-error "option must be specified with argument: --~a"
(option-spec->name spec))
(loop (- unclumped 2) (cdr ls) (acons spec (car ls) found) etc)))
;; Whatever the presentation of the long option, make sure it is in a
;; clean, normalized form (but this does NOT account for any value the
;; option might have).
(define (re-present option)
(string-append "--" (isolate-long-name option) "="))
;; The /name/ can take the form of a long option entry on the command
;; line, with whatever decoration that entails. Will return #f if a
;; spec does not exist for this named option.
(define (find-spec-long specs name)
(and=> (isolate-long-name name)
(λ (name) (find (λ (a) (string=? (option-spec->name a) name)) specs))))
;; Return #f if a spec with the short /letter/ name does not exist.
(define (find-spec-short specs letter)
(find (λ (a) (eqv? (option-spec->single-char a) letter)) specs))
;; Take, for example, /short/='-h' to '--help='.
(define (double-up short specs)
(and=> (find-spec-short specs (string-ref short 1))
(λ (spec) (string-append "--" (option-spec->name spec) "="))))
;; This procedure does whatever is necessary to put the (ostensibly)
;; first item on the command-line into the canonical (normal) form
;; '--item=value'; this may mean consuming the next item of the
;; command-line (the first item of /rest/) to get the value. Note that
;; the value may be missing, but the '=' sign will always be there in
;; the return. The first item (/A/) will always be more than two
;; characters, and the first two characters will be "--", i.e. we are
;; processing a long option.
;;
;; A IN string The first argument on the command-line
;; rest IN list of strings The remaining items of the command-line
;; specs IN list of option-spec Options specification
;; remnant OUT list of strings The unprocessed command line
;; processed OUT string New command-line argument
(define (normalize-long-option A rest specs)
(define (return-empty-arg) (values rest (re-present A)))
(define (return-arg-with-value)
(values (cdr rest) (string-append (re-present A) (car rest))))
(cond
((string-index A #\=)
;; The argument is already in the canonical form.
(values rest A))
((find-spec-long specs A)
=> (λ (spec)
(if (cond ((null? rest) #f)
((option-spec->predicate spec)
=> (λ (pred) (pred (car rest))))
(else
(case (option-spec->value-policy spec)
((#f) #f)
((optional)
(not (eqv? (string-ref (car rest) 0) #\-)))
((#t)
(or (string->number (car rest))
(not (eqv? (string-ref (car rest) 0) #\-)))))))
(return-arg-with-value)
(return-empty-arg))))
(else
;; We know nothing about this option, abort operations.
(fatal-error "no such option: --~a" (isolate-long-name A)))))
;; This procedure does whatever is necessary to put the (ostensibly)
;; first item on the command-line into the canonical form
;; '--item=value'; this may mean consuming the next item of the
;; command-line (the first item of /rest/) to get the value. Note that
;; the value may be missing, but the '=' sign will always be there in
;; the return. The first item (/A/) will always be exactly two
;; characters, and the first character will be "-", i.e. we are
;; processing an isolated short option.
;;
;; A IN string The first argument on the command-line
;; rest IN list of strings The remaining items of the command-line
;; specs IN list of option-spec Options specification
;; remnant OUT list of strings The unprocessed command line
;; processed OUT string New command-line argument
(define (normalize-free-short-option A rest specs)
(define (return-empty-arg) (values rest (double-up A specs)))
(define (return-arg-with-next-value)
(values (cdr rest) (string-append (double-up A specs) (car rest))))
(let* ((name (string-ref A 1))
(spec (find-spec-short specs name)))
(if (cond ((not spec) (fatal-error "no such option: -~a" name))
((null? rest) #f)
((option-spec->predicate spec)
=> (λ (pred) (pred (car rest))))
(else (case (option-spec->value-policy spec)
((optional) (not (eq? (string-ref (car rest) 0) #\-)))
(else => identity))))
(return-arg-with-next-value)
(return-empty-arg))))
;; The /sequence/ is a string of characters from the command line, and
;; the task is to decide if those characters are a viable clumped option
;; sequence, possibly using some of the trailing characters as option
;; values, or not.
(define (viable-short sequence specs)
(cond ((eq? 0 (string-length sequence)) #t)
((find-spec-short specs (string-ref sequence 0))
=> (λ (spec)
(cond ((option-spec->predicate spec)
=> (λ (pred) (pred (substring sequence 1))))
(else
;; If this optionʼs /value-policy/ allows the
;; option to take a value then this string is
;; viable as the remainder can be taken as that
;; value. Otherwise we must assert the viability
;; of the rest of the line by recursion.
(or (not (eq? #f (option-spec->value-policy spec)))
(viable-short (substring sequence 1) specs))))))
(else #f)))
;; This procedure does whatever is necessary to put the (ostensibly)
;; first item on the command-line into the canonical form
;; '--item=value'. Note that the value may be missing, but the '='
;; sign will always be there in the return. The first item (/A/) will
;; always be *more* than two characters, and the first character will
;; be "-", i.e. we are processing a short option which is either
;; clumped with other short options, or is clumped with its value.
;;
;; NOTE that, contrary to the other normalize procedures, the return
;; value of /processed/ can be #f, with the expectation that the
;; modified /remnant/ will be re-processed.
;;
;; A IN string The first argument on the command-line
;; rest IN list of strings The remaining items of the command-line
;; specs IN list of option-spec Options specification
;; remnant OUT list of strings The unprocessed command line
;; processed OUT string New command-line argument
(define (normalize-clumped-short-option A rest specs)
(define (declump-arg) (values (cons* (string-append "-" (substring A 1 2))
(string-append "-" (substring A 2))
rest)
#f))
(define (construct-arg-from-clumped-value)
(values rest (string-append (double-up A specs) (substring A 2))))
(unless (char-alphabetic? (string-ref A 1)) (values rest A))
(let ((spec (find-spec-short specs (string-ref A 1))))
(if (cond ((not spec) (fatal-error "no such option: -~a" (string-ref A 1)))
((option-spec->predicate spec)
=> (λ (pred) (pred (substring A 2))))
(else (case (option-spec->value-policy spec)
((optional) (not (viable-short (substring A 2) specs)))
(else => identity))))
(construct-arg-from-clumped-value)
(declump-arg))))
;; Return a version of the command-line /args/ in which all options are
;; represented in long form with an equals sign (whether they have a
;; value or not).
(define (normalize args specs stop-at-first-non-option?)
(call/ec
(λ (return)
(let loop ((args args) (processed '()))
(when (null? args) (return (reverse processed)))
(define A (car args))
(define L (string-length A))
(define (when-loop cond normalizer)
(when cond
(receive (remainder-args processed-arg)
(normalizer A (cdr args) specs)
(loop
remainder-args
(if processed-arg
(cons processed-arg processed)
processed)))))
(when (string=? "--" A)
(return (append (reverse processed) args)))
(when-loop (and (> L 2) (string=? (substring A 0 2) "--"))
normalize-long-option)
(when-loop (and (eqv? L 2) (eqv? (string-ref A 0) #\-))
normalize-free-short-option)
(when-loop (and (> L 1) (eqv? (string-ref A 0) #\-))
normalize-clumped-short-option)
(if stop-at-first-non-option?
(return (append (reverse processed) args))
(loop (cdr args) (cons A processed)))))))
;; Check that all the rules inherent in the /specs/ are fulfilled by
;; the /options/.
(define (verify-specs-fullfilled specs options)
(for-each
(λ (spec)
(let* ((name (option-spec->name spec))
(value (assq-ref options (string->symbol name))))
(when (and (option-spec->required? spec) (not value))
(fatal-error "option must be specified: --~a" name))
(let ((policy (option-spec->value-policy spec)))
(when (and (eq? policy #t) (eq? value #t))
(fatal-error "option must be specified with argument: --~a" name))
(when (and (eq? policy #f) (string? value))
(fatal-error "option does not support argument: --~a" name)))
(let ((pred (option-spec->predicate spec)))
(when (and pred (string? value) (not (pred value)))
(fatal-error "option predicate failed: --~a" name)))))
specs))
;; Check that all the options are matched by a specification.
(define (verify-options options specs)
(for-each
(λ (value)
(unless (or (null? (car value))
(find-spec-long specs (symbol->string (car value))))
(fatal-error "no such option: --~a" (car value))))
options))
;; This procedure will simply return if the options and the specs
;; conform with each other, or else will bail out with an error
;; message.
(define (check-compliance options specs)
(verify-specs-fullfilled specs options)
(verify-options options specs))
(define full-option-re (make-regexp "^--([^=]+)=(.+)?$"))
;; The /normal-args/ are a normalized command line in which all
;; options are expressed long-form, and the task here is to construct an
;; /options/ object: an associative array of option names onto values
;; (or #t if there is no value).
(define (extract-options normal-args stop-at-first-non-option?)
(let loop ((args normal-args)
(options '())
(non-options '()))
(cond
((null? args) (acons '() (reverse non-options) options))
((string=? (car args) "--")
(acons '() (append (reverse non-options) (cdr args)) options))
((regexp-exec full-option-re (car args))
=> (λ (match)
(loop (cdr args)
(acons (string->symbol (match:substring match 1))
(or (match:substring match 2) #t)
options)
non-options)))
(stop-at-first-non-option?
(acons '() (append (reverse non-options) args) options))
(else
(loop (- unclumped 1) ls (acons spec #t found) etc))))
(match argument-ls
(()
(cons found (reverse etc)))
((opt . rest)
(cond
((regexp-exec short-opt-rx opt)
=> (lambda (match)
(if (> unclumped 0)
;; Next option is known not to be clumped.
(let* ((c (match:substring match 1))
(spec (or (assoc-ref sc-idx c)
(fatal-error "no such option: -~a" c))))
(eat! spec rest))
;; Expand a clumped group of short options.
(let* ((extra (match:substring match 2))
(unclumped-opts
(append (map (lambda (c)
(string-append "-" (make-string 1 c)))
(string->list
(match:substring match 1)))
(if (string=? "" extra) '() (list extra)))))
(loop (length unclumped-opts)
(append unclumped-opts rest)
found
etc)))))
((regexp-exec long-opt-no-value-rx opt)
=> (lambda (match)
(let* ((opt (match:substring match 1))
(spec (or (assoc-ref idx opt)
(fatal-error "no such option: --~a" opt))))
(eat! spec rest))))
((regexp-exec long-opt-with-value-rx opt)
=> (lambda (match)
(let* ((opt (match:substring match 1))
(spec (or (assoc-ref idx opt)
(fatal-error "no such option: --~a" opt))))
(if (option-spec->value-policy spec)
(eat! spec (cons (match:substring match 2) rest))
(fatal-error "option does not support argument: --~a"
opt)))))
((and stop-at-first-non-option
(<= unclumped 0))
(cons found (append (reverse etc) argument-ls)))
(else
(loop (- unclumped 1) rest found (cons opt etc)))))))))
(loop (cdr args) options (cons (car args) non-options))))))
(define* (getopt-long program-arguments option-desc-list
#:key stop-at-first-non-option)
"Process options, handling both long and short options, similar to
"- Scheme Procedure: getopt-long PROGRAM-ARGUMENTS OPTION-DESC-LIST
[#:stop-at-first-non-option]
Process options, handling both long and short options, similar to
the glibc function 'getopt_long'. PROGRAM-ARGUMENTS should be a value
similar to what (program-arguments) returns. OPTION-DESC-LIST is a
list of option descriptions. Each option description must satisfy the
@ -337,35 +529,24 @@ or option values.
By default, options are not required, and option values are not
required. By default, single character equivalents are not supported;
if you want to allow the user to use single character options, you need
to add a `single-char' clause to the option description."
(with-fluids ((%program-name (car program-arguments)))
(let* ((specifications (map parse-option-spec option-desc-list))
(pair (split-arg-list (cdr program-arguments)))
(split-ls (car pair))
(non-split-ls (cdr pair))
(found/etc (process-options specifications split-ls
stop-at-first-non-option))
(found (car found/etc))
(rest-ls (append (cdr found/etc) non-split-ls)))
(for-each (lambda (spec)
(let ((name (option-spec->name spec))
(val (assq-ref found spec)))
(and (option-spec->required? spec)
(or val
(fatal-error "option must be specified: --~a"
name)))
(let ((pred (option-spec->predicate spec)))
(and pred (pred name val)))))
specifications)
(for-each (lambda (spec+val)
(set-car! spec+val
(string->symbol (option-spec->name (car spec+val)))))
found)
(cons (cons '() rest-ls) found))))
to add a ‘single-char’ clause to the option description."
(parameterize ((program-name (car program-arguments)))
(let* ((specs (map parse-option-spec option-desc-list))
(options (extract-options
(normalize (cdr program-arguments)
specs
stop-at-first-non-option)
stop-at-first-non-option)))
(check-compliance options specs)
options)))
(define (option-ref options key default)
"Return value in alist OPTIONS using KEY, a symbol; or DEFAULT if not found.
The value is either a string or `#t'."
"Return value in OPTIONS (as returned from getopt-long), using KEY--
a symbol--, or DEFAULT if not found. The value is either a string or
‘#t’, or whatever DEFAULT is."
(or (assq-ref options key) default))
;;; getopt-long.scm ends here