+(define* (display-help program-name command)
+ "Display help message"
+
+ ;; Usage
+ (format #t "Usage: ~a [OPTIONS]" program-name)
+ (when (group? command)
+ (format #t " COMMAND [ARGS]..."))
+ (format #t "~%~%")
+
+ ;; Title
+ (let ((title (get-help-text command)))
+ (when title
+ (format #t " ~a~%~%" title)))
+
+ ;; Options
+ (format #t "Options:~%")
+ (let ((options (map (lambda (option)
+ (cons (format #f
+ "--~a~a~a"
+ (car option)
+ (let ((single-char
+ (option-property option 'single-char)))
+ (if single-char
+ (format #f ", -~a" single-char)
+ ""))
+ (let ((value
+ (not (option-property option 'flag))))
+ (if value
+ (format #f " ~a" (get-type-description option))
+ "")))
+ (option-property option 'help "")))
+ (command-option-spec command))))
+ (display-options options))
+
+ ;; Commands
+ (when (group? command)
+ (format #t "~%Commands:~%")
+ (let ((options (map (lambda (command)
+ (cons (or (command-name command) "")
+ (or (get-help-text command) "")))
+ (command-commands command))))
+ (display-options options))))
+
+