diff --git a/congame-core/components/formular.rkt b/congame-core/components/formular.rkt index d67d0f1..5b9e725 100644 --- a/congame-core/components/formular.rkt +++ b/congame-core/components/formular.rkt @@ -2,13 +2,14 @@ (require (for-syntax racket/base racket/syntax - syntax/parse) + syntax/parse/pre) forms koyo/haml (prefix-in m: marionette) racket/list racket/match racket/port + threading (prefix-in bot: (submod "bot.rkt" actions)) (prefix-in study: "study.rkt") web-server/http) @@ -38,7 +39,8 @@ input-time textarea make-checkboxes - make-radios) + make-radios + make-radios-with-other) (define (kwd->symbol kwd) (string->symbol (keyword->string kwd))) @@ -157,7 +159,11 @@ [{~or (kwd:keyword _) (kwd:keyword _ _)} #'(let ([entry (hash-ref tbl 'kwd)]) - (rw (car entry) ((cdr entry) 'widget)))] + (let ([widget ((cdr entry) 'widget)]) + (if widget + (rw (car entry) widget) + (((cdr entry) 'widget/ns) + (widget-namespace (car entry) rw)))))] [(e ...) #`(#,@(map loop (syntax-e #'(e ...))))] @@ -167,7 +173,11 @@ (syntax->datum #'(dynamic-field-id ...))) #:with kwd (datum->syntax #'e (string->keyword (symbol->string (syntax-e #'e)))) #'(let ([entry (hash-ref tbl 'kwd)]) - (rw (car entry) ((cdr entry) 'widget)))] + (let ([widget ((cdr entry) 'widget)]) + (if widget + (rw (car entry) widget) + (((cdr entry) 'widget/ns) + (widget-namespace (car entry) rw)))))] [e #'e])) #:with defaults @@ -602,6 +612,76 @@ (render-proc options make-radio) ,@((widget-errors) name value errors))))])) +(define ((make-radios-with-other options + #:required? [required? #t] + #:other-label [other-label "Other:"] + #:radio-validators [radio-validators null] + #:other-validators [other-validators null] + #:radio-attributes [radio-attributes null] + #:other-attributes [other-attributes '((placeholder "Other..."))]) meth) + (match meth + ['validator + (form* ([radio-value (apply ensure binding/symbol radio-validators)] + [other-value (apply ensure binding/text other-validators)]) + (if other-value + (ok other-value) + (if radio-value + (ok radio-value) + (if required? + (err '((radio-value . "You must pick a value or write something in the other field."))) + (ok #f)))))] + ['widget #f] + ['widget/ns + (lambda (rw) + (define (widget-radio-value name value _errors) + (let ([value (get-binding-value value)]) + `(div + ,@(for/list ([opt (in-list options)]) + (match-define (cons option label) + opt) + `(div + (label + (input + ([name ,name] + [type "radio"] + [value ,(symbol->string option)] + ,@(if (eq? (string->symbol value) option) + (cons '(checked "") radio-attributes) + radio-attributes))) + ,label)))))) + + (define (widget-other-value name value _errors) + `(label + ,other-label + (script + #<