123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596 |
- (use-modules (srfi srfi-37))
- ;; store the options globally
- (define options (make-hash-table 10))
- ;; make a procedure that only displays message and then exits
- (define (display-and-exit-proc msg)
- ;; needs to take the mandatory arguments though
- (lambda (opt name arg loads)
- ;; now only display
- (display msg)
- ;; and then quit the program
- (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))
- ;; "and the processor should return seeds as well."
- 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
- ;; args-fold calls the processors of the options with the following arguments:
- ;; - the containing option object,
- ;; - the name used on the command line,
- ;; - the argument given for the option (or #f if none)
- ;; - the rest of the arguments are args-fold “seeds”
- ;; and the processor should return seeds as well.
- ;; specify the options in a list of option objects
- (list (option '(#\v "version") ; short name and long name
- #f ; required-arg? - option must be followed by an argument
- #f ; optional-arg? - option takes an argument if available
- (display-and-exit-proc "Foo version 42.0\n")) ; processor of option
- (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
- ;; (program-arguments) simply contains all arguments to the guile command
- ;; We do not need the filename of the program, so we discard it and only use the cdr.
- (cdr (program-arguments))
- ;; use previously defined option specification
- option-spec
- ;; What happens when unknown arguments are given?
- ;; Unknown argument handling procedure.
- (lambda (opt name arg loads)
- (error (simple-format #f "Unrecognized option: ~A\n~A" name usage-help)))
- ;; Call operand-proc with any items on the command line that are not named options.
- ;; This includes arguments after ‘--’.
- ;; It is called with the argument in question, as well as the seeds.
- (lambda (op loads)
- (cons op loads))
- ;; seed - What is the seed???
- '())
- (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)
|