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.

186 lines
5.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 general-utils srfi-19 (prefix utf8 utf8:) (prefix utf8-srfi-13 utf8:)) ,_markup)))
(attributes . ,_attributes))
(interaction-environment))
(set! *widgets* (widgets))
(set! *widget-rules* (widget-rules))))
(widget
'stylesheet
``(link (@ (href ,path) (type "text/css")
(rel "stylesheet")))
`((path "")))
(widget
'row
``(div (@ (class ,(string-append "row" (if no-padding " collapse" "") " " class)) (style ,style) (id ,(if id id "")))
,@contents)
`((no-padding #f) (style ()) (class "") (id #f)))
(widget
'col
``(div (@ (class ,(string-append class " "
(if large (string-append " large-" (number->string large)) "")
(if medium (string-append " medium-" (number->string medium)) "")
(if small (string-append " small-" (number->string small)) "")
(if large-offset
(string-append " large-offset-" (number->string large-offset))
"")
(if medium-offset
(string-append " medium-offset-" (number->string medium-offset))
"")
(if small-offset
(string-append " small-offset-" (number->string small-offset))
"")
" columns"))
(id ,(if id id ""))) ,@contents)
`((large #f) (medium #f) (small #f) (large-offset #f) (medium-offset #f) (small-offset #f)
(class "") (id #f)))
(widget
'col-end
``(div (@ (class "column end")) "")
`())
(widget
'column-layout
`(let ((class (++ "column small-"
(number->string
(inexact->exact (round (/ 12 (or cols (length contents)))))))))
`(div (@ (class ,(++ "row" (if padding "" " collapse"))))
,@(map (lambda (col)
`(div (@ (class ,class)) ,col))
contents)
,(if fill-row `(div (@ (class "column end"))) "")))
`((fill-row #t) (cols #f) (padding #t)))
(widget
'row-layout
``(div
,@(map (lambda (r) `(row (@ (no-padding ,(not padding))) (col (@ (small 12)) ,r)))
contents))
'((padding #t)))
(widget
'panel
``(div (@ (class "panel")) ,@contents)
`())
(widget
'panel-small
``(div (@ (class "panel panel-small")) ,@contents)
`())
(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 ,(if (eq? placement 'vertical)
"vertical-spacer"
"horizontal-spacer"))) ,@contents)
`((placement vertical)))
(widget
'modal
``(div (@ (class "modal-overlay"))
(div (@ (class "modal-content"))
,@contents))
`())
(widget
'external-link
``(a (@ (href ,href)) ,@contents)
`((href "")))
(widget
'select-box
``(select (@ (name ,select-name) ,type ,@attrs)
,@(map
(lambda (o)
`(option (@ (name ,(or (and (list? o) (alist-ref 'name o)) o))
,@(or (and (list? o) (alist-ref 'selected o)
'(selected))
'()))
,(or (and (list? o) (alist-ref 'body o)) o)))
contents))
'((select-name "") (type "") (attrs '())))
(widget
'nav-bar-title
``(ul (@ (class "title-area"))
(li (@ (class "name"))
,(if title `(h1 (a (@ (href ,url)) ,title)) ""))
(li (@ (class "toggle-topbar menu-icon"))
(a (@ (href "#")) (span "Menu"))))
'((title #f) (url "#")))
(widget
'nav-bar-section
``(ul ,@(if (eq? float 'right) '((@ (class "right"))) '())
,@contents)
'((float #f)))
(widget
'nav-bar-item
``(li (@ (class ,(if active "active" "")))
(a (@ (href ,url)) ,@contents))
'((active #f) (url "#")))
(widget
'nav-bar-dropdown-item
``(li (@ (class ,(++ "has-dropdown " (if active "active" ""))))
(a (@ (href ,url)) ,title)
(ul (@ (class "dropdown"))
,@contents))
'((active #f) (url "#") (title "")))
(widget
'nav-bar
``(div (@ (class "contain-to-grid"))
(nav (@ (class "top-bar") data-topbar (role "navigation")
(data-options "is_hover: true"))
,@(if title `(,title) '())
(section (@ (class "top-bar-section"))
,@contents)))
'((title #f)))
(widget
'sub-nav-item
``(dd (@ ,@(if active '((class "active")) '()))
,@contents)
'((active #f)))
(widget
'sub-nav
``(dl (@ (class "sub-nav"))
(dt ,label)
,@contents)
'((label "")))