You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
98 lines
2.4 KiB
Scheme
98 lines
2.4 KiB
Scheme
(define *widgets* (widgets))
|
|
(define *widget-rules* (widget-rules))
|
|
|
|
(define-syntax with-widgets
|
|
(syntax-rules ()
|
|
((_ widgets* widget-rules* body ...)
|
|
(parameterize ((widgets widgets*) (widget-rules widget-rules*))
|
|
body ...))))
|
|
|
|
;; Make defining widgets less cumbersome and prevent conflicting
|
|
;; transform definitions that are hard to debug.
|
|
(define (widget name _markup _attributes)
|
|
(parameterize ((widgets *widgets*) (widget-rules *widget-rules*))
|
|
(add-widget name `((markup . `(*TOP* ,(begin (use uri-common) ,_markup)))
|
|
(attributes . ,_attributes))
|
|
(interaction-environment))
|
|
(set! *widgets* (widgets))
|
|
(set! *widget-rules* (widget-rules))))
|
|
|
|
|
|
(widget
|
|
'stylesheet
|
|
``(link (@ (href ,(string-append "/res/css/" path)) (type "text/css")
|
|
(rel "stylesheet")))
|
|
'((path "")))
|
|
|
|
(widget
|
|
'row
|
|
``(div (@ (class ,(conc "row" (if full-width " full-width " "")
|
|
(if padding "" " collapse ")))) ,@contents)
|
|
'((full-width #f) (padding #t)))
|
|
|
|
(widget
|
|
'col
|
|
``(div (@ (class ,(conc "column small-" width)) ,@attrs) ,@contents)
|
|
'((width 1) (attrs ())))
|
|
|
|
(widget
|
|
'cols
|
|
`(let ((class (++ "column small-" (number->string
|
|
(inexact->exact (round (/ 12 (length contents))))))))
|
|
`(div (@ (class ,(conc "row" (if full-width " full-width" ""))))
|
|
,@(map (lambda (col)
|
|
`(div (@ (class ,class)) ,col))
|
|
contents)
|
|
,(if fill-row `(div (@ (class "column end"))) "")))
|
|
'((fill-row #t) (full-width #f)))
|
|
|
|
(widget
|
|
'panel
|
|
``(div (@ (class "panel")) ,@contents)
|
|
'())
|
|
|
|
(widget
|
|
'panel-small
|
|
``(div (@ (class "panel panel-small") ,@attrs) ,@contents)
|
|
'((attrs '())))
|
|
|
|
(widget
|
|
'text-center
|
|
``(div (@ (class "text-center")) ,@contents)
|
|
'())
|
|
|
|
(widget
|
|
'group-box
|
|
``(div (@ (class "panel group-box"))
|
|
(h4 (@ (class "group-box-title")) ,title)
|
|
,@contents)
|
|
'((title "")))
|
|
|
|
(widget
|
|
'radio-button
|
|
``(label (input (@ (type "radio") (name ,name))) ,label)
|
|
'((name "radio1") (label "radio1")))
|
|
|
|
(widget
|
|
'spacer
|
|
``(div (@ (class "spacer")) ,@contents)
|
|
'())
|
|
|
|
(widget
|
|
'modal
|
|
``(div (@ (class "modal-overlay"))
|
|
(div (@ (class "modal-content"))
|
|
,@contents))
|
|
'())
|
|
|
|
(widget
|
|
'include-javascript
|
|
``(script (@ (language "javascript") (type "text/javascript")
|
|
(src ,(conc "/res/js/" (car contents)))))
|
|
'())
|
|
|
|
(widget
|
|
'spock-scripts
|
|
``(include-javascript "spock-runtime-debug.js")
|
|
'())
|