using-srfi-37.scm 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596
  1. (use-modules (srfi srfi-37))
  2. ;; store the options globally
  3. (define options (make-hash-table 10))
  4. ;; make a procedure that only displays message and then exits
  5. (define (display-and-exit-proc msg)
  6. ;; needs to take the mandatory arguments though
  7. (lambda (opt name arg loads)
  8. ;; now only display
  9. (display msg)
  10. ;; and then quit the program
  11. (quit)))
  12. (define* (make-store-in-options-proc #:optional (key #f))
  13. "Make a processor, which stores the option in the options hash
  14. table, optionally taking a key under which to store the value."
  15. (lambda (opt name arg loads)
  16. (display
  17. (simple-format #f
  18. "storing the following option and value: ~a, ~a\n"
  19. (if key key name)
  20. arg))
  21. (if key
  22. (hash-set! options key arg)
  23. (hash-set! options name arg))
  24. ;; "and the processor should return seeds as well."
  25. loads))
  26. (define usage-help
  27. (string-join '(""
  28. "foo.scm [options]"
  29. "-v, --version Display version"
  30. "-h, --help Display this help"
  31. "-u, --user-name user name greeted by this program"
  32. "-n, --times number of greetings"
  33. "")
  34. "\n"))
  35. (define option-spec
  36. ;; args-fold calls the processors of the options with the following arguments:
  37. ;; - the containing option object,
  38. ;; - the name used on the command line,
  39. ;; - the argument given for the option (or #f if none)
  40. ;; - the rest of the arguments are args-fold “seeds”
  41. ;; and the processor should return seeds as well.
  42. ;; specify the options in a list of option objects
  43. (list (option '(#\v "version") ; short name and long name
  44. #f ; required-arg? - option must be followed by an argument
  45. #f ; optional-arg? - option takes an argument if available
  46. (display-and-exit-proc "Foo version 42.0\n")) ; processor of option
  47. (option '(#\h "help") #f #f
  48. (display-and-exit-proc usage-help))
  49. (option '(#\u "user-name") #t #f
  50. (make-store-in-options-proc "user-name"))
  51. (option '(#\n "times") #t #f
  52. (λ (opt name arg loads)
  53. (cond
  54. [(exact-integer? (string->number arg))
  55. ((make-store-in-options-proc "times") opt name arg loads)]
  56. [else
  57. (error
  58. (simple-format #f
  59. "option predicate for option ~a not true: ~a"
  60. name "(exact-integer? (string->number arg))"))])))))
  61. (args-fold
  62. ;; (program-arguments) simply contains all arguments to the guile command
  63. ;; We do not need the filename of the program, so we discard it and only use the cdr.
  64. (cdr (program-arguments))
  65. ;; use previously defined option specification
  66. option-spec
  67. ;; What happens when unknown arguments are given?
  68. ;; Unknown argument handling procedure.
  69. (lambda (opt name arg loads)
  70. (error (simple-format #f "Unrecognized option: ~A\n~A" name usage-help)))
  71. ;; Call operand-proc with any items on the command line that are not named options.
  72. ;; This includes arguments after ‘--’.
  73. ;; It is called with the argument in question, as well as the seeds.
  74. (lambda (op loads)
  75. (cons op loads))
  76. ;; seed - What is the seed???
  77. '())
  78. (define (main options)
  79. (let ([user-name (hash-ref options "user-name" #f)]
  80. [times (string->number (hash-ref options "times" "1"))])
  81. (do ([i 0 (1+ i)])
  82. ([>= i times])
  83. (display (simple-format #f "Hello ~a!\n" (if user-name
  84. user-name
  85. "World"))))))
  86. (main options)