(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 "")))