123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869 |
- (use-modules (srfi srfi-37))
- (define options (make-hash-table 10))
- (define (display-and-exit-proc msg)
- (lambda (opt name arg loads)
- (display msg)
- (quit)))
- (define* (make-store-in-options-proc #:optional (key #f))
- "Make a processor, which stores the option in the options hash table, optionally taking a key under which to store the value."
- (lambda (opt name arg loads)
- (display
- (simple-format #f
- "storing the following option and value: ~a, ~a\n"
- (if key key name)
- arg))
- (if key
- (hash-set! options key arg)
- (hash-set! options name arg))
- loads))
- (define usage-help
- (string-join '(""
- "foo.scm [options]"
- "-v, --version Display version"
- "-h, --help Display this help"
- "-u, --user-name user name greeted by this program"
- "-n, --times number of greetings"
- "")
- "\n"))
- (define option-spec
- (list (option '(#\v "version") #f #f
- (display-and-exit-proc "Foo version 42.0\n"))
- (option '(#\h "help") #f #f
- (display-and-exit-proc usage-help))
- (option '(#\u "user-name") #t #f
- (make-store-in-options-proc "user-name"))
- (option '(#\n "times") #t #f
- (λ (opt name arg loads)
- (cond
- [(exact-integer? (string->number arg))
- ((make-store-in-options-proc "times") opt name arg loads)]
- [else
- (error
- (simple-format #f
- "option predicate for option ~a not true: ~a"
- name "(exact-integer? (string->number arg))"))])))))
- (args-fold (cdr (program-arguments))
- option-spec
- (lambda (opt name arg loads)
- (error (simple-format #f "Unrecognized option: ~A\n~A" name usage-help)))
- (lambda (op loads)
- (cons op loads))
- '())
- (define (main options)
- (let ([user-name (hash-ref options "user-name" #f)]
- [times (string->number (hash-ref options "times" "1"))])
- (do ([i 0 (1+ i)])
- ([>= i times])
- (display (simple-format #f "Hello ~a!\n" (if user-name
- user-name
- "World"))))))
- (main options)
|