no-comments.scm 2.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869
  1. (use-modules (srfi srfi-37))
  2. (define options (make-hash-table 10))
  3. (define (display-and-exit-proc msg)
  4. (lambda (opt name arg loads)
  5. (display msg)
  6. (quit)))
  7. (define* (make-store-in-options-proc #:optional (key #f))
  8. "Make a processor, which stores the option in the options hash table, optionally taking a key under which to store the value."
  9. (lambda (opt name arg loads)
  10. (display
  11. (simple-format #f
  12. "storing the following option and value: ~a, ~a\n"
  13. (if key key name)
  14. arg))
  15. (if key
  16. (hash-set! options key arg)
  17. (hash-set! options name arg))
  18. loads))
  19. (define usage-help
  20. (string-join '(""
  21. "foo.scm [options]"
  22. "-v, --version Display version"
  23. "-h, --help Display this help"
  24. "-u, --user-name user name greeted by this program"
  25. "-n, --times number of greetings"
  26. "")
  27. "\n"))
  28. (define option-spec
  29. (list (option '(#\v "version") #f #f
  30. (display-and-exit-proc "Foo version 42.0\n"))
  31. (option '(#\h "help") #f #f
  32. (display-and-exit-proc usage-help))
  33. (option '(#\u "user-name") #t #f
  34. (make-store-in-options-proc "user-name"))
  35. (option '(#\n "times") #t #f
  36. (λ (opt name arg loads)
  37. (cond
  38. [(exact-integer? (string->number arg))
  39. ((make-store-in-options-proc "times") opt name arg loads)]
  40. [else
  41. (error
  42. (simple-format #f
  43. "option predicate for option ~a not true: ~a"
  44. name "(exact-integer? (string->number arg))"))])))))
  45. (args-fold (cdr (program-arguments))
  46. option-spec
  47. (lambda (opt name arg loads)
  48. (error (simple-format #f "Unrecognized option: ~A\n~A" name usage-help)))
  49. (lambda (op loads)
  50. (cons op loads))
  51. '())
  52. (define (main options)
  53. (let ([user-name (hash-ref options "user-name" #f)]
  54. [times (string->number (hash-ref options "times" "1"))])
  55. (do ([i 0 (1+ i)])
  56. ([>= i times])
  57. (display (simple-format #f "Hello ~a!\n" (if user-name
  58. user-name
  59. "World"))))))
  60. (main options)