quoting woes pasted by andyjpb on Thu Jun 28 18:36:49 2012
(define widget-debugger-page
(let* ((widget-names (map car (widgets)))
(menu-items (map (lambda (name)
`(menu-item (@ (id ,(symbol->string name))
(icon "home")
(text ,(symbol->string name))
(href "/")
)))
widget-names))
(test (pp menu-items))
(test (pp `(layout (@ (menu-items `(,,menu-items))))))
(test (pp `(layout (@ (menu-items ;,menu-items
`((menu-item (@ (id "statusbox") (icon "home") (text "statusbox") (href "/")))
(menu-item (@ (id "menu-item") (icon "home") (text "menu-item") (href "/"))))
)))))
;(menu-items ''((menu-item (@ (id "home") (icon "home") (text "Home") (href "/"))))))
)
`(layout (@ (menu-items ;,menu-items
`((menu-item (@ (id "statusbox") (icon "home") (text "statusbox") (href "/")))
(menu-item (@ (id "menu-item") (icon "home") (text "menu-item") (href "/"))))
)
(title "Widget Debugger"))
(h1 "Welcome to the Widget Debugger")
(groupbox (@ (title "Test"))
(statusbox)
)
(h1 (@ (style "clear: both;")) "---B<---")
)))
improved pasted by andyjpb on Thu Jun 28 18:48:28 2012
(define widget-debugger-page
(let* ((widget-names (map car (widgets)))
(menu-items (map (lambda (name)
`(menu-item (@ (id ,(symbol->string name))
(icon "home")
(text ,(symbol->string name))
(href "/")
)))
widget-names))
(test (pp `(layout (@ (menu-items ,menu-items)))))
(menu-items ''((menu-item (@ (id "home") (icon "home") (text "Home") (href "/")))
(menu-item (@ (id "home") (icon "home") (text "Home") (href "/")))
))
(test (pp menu-items))
(test (pp `(layout (@ (menu-items ,menu-items)))))
)
`(layout (@ (menu-items ,menu-items
;`((menu-item (@ (id "statusbox") (icon "home") (text "statusbox") (href "/")))
; (menu-item (@ (id "menu-item") (icon "home") (text "menu-item") (href "/"))))
)
(title "Widget Debugger"))
(h1 "Welcome to the Widget Debugger")
(groupbox (@ (title "Test"))
(statusbox)
)
(h1 (@ (style "clear: both;")) "---B<---")
)))
This? pasted by mario-goulart on Thu Jun 28 18:56:56 2012
(define (widgets) '((foo) (bar))) (define widget-debugger-page (let* ((widget-names (map car (widgets))) (menu-items (map (lambda (name) `(menu-item (@ (id ,(symbol->string name)) (icon "home") (text ,(symbol->string name)) (href "/") ))) widget-names))) `(layout (@ (menu-items ,menu-items) (title "Widget Debugger")) (h1 "Welcome to the Widget Debugger") (groupbox (@ (title "Test")) (statusbox)) (h1 (@ (style "clear: both;")) "---B<---") ))) (pp widget-debugger-page)
renderer pasted by andyjpb on Thu Jun 28 19:11:54 2012
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; WIDGETS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (use environments) (define widgets (make-parameter '())) ; The markup / definition of each widget. (define widget-rules (make-parameter '())) ; The SXML rule that will render each widget. (widgets (cons `(paragraph . `((h1 ,title) (p ,contents))) (widgets))) (widgets (cons `(link . `(a (@ (href ,href)) ,title)) (widgets))) (define (load-widget widgetname filename) (widgets (cons `(,widgetname . ,(car (read-file filename))) (widgets))) (widget-rules (cons `(,widgetname *macro* . ,convert) (widget-rules))) ; Just call convert for each widget. ) (load-widget 'simple "simple.sxml") (define (get-widget widget-name) (and-let* ((widget (assq widget-name (widgets)))) (cdr widget))) (define widget-eval-env (make-parameter (environment-copy (interaction-environment) #t))) (define (render sxml bindings contents) ;(eval `(let ((title "hello") (++ string-append)) ,sxml)) (let ((env (environment-copy (widget-eval-env)))) (environment-set! env 'contents contents) (eval `(let (,@bindings (++ string-append)) ,sxml) env))) (define convert (lambda (t b) (or ; If there's a widget with this name, render it otherwise passthru (and-let* ((widget (get-widget t)) (bindings (if (and (pair? b) (pair? (car b)) (eq? '@ (caar b))) (cdar b) '())) (contents (if (and (pair? b) (pair? (car b)) (eq? '@ (caar b))) (cdr b) b))) (render widget bindings contents)) (cons t b)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SXML ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (use sxml-transforms) (define (knodium-sxml->html sxml) (let* ((knodium-rules `( (*text* . ,(lambda (tag str) str)) (*default* . ,cons) . ,(widget-rules) ; Each widget needs its own rule as we can't use *macro* with *default* without creating an endless loop. )) (rules `( (literal *preorder* . ,(lambda (t b) b)) (*DECL* *preorder* . ,(lambda (t b) (conc "<!" (apply conc (intersperse (car b) " ")) " " ">"))) (*COMMENT* *preorder* . ,(lambda (t b) (conc "<!-- " (apply conc b) " -->"))) . ,universal-conversion-rules* ))) (SRV:send-reply (pre-post-order* (pre-post-order* sxml knodium-rules) rules)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (load-widget 'multiblock "multiblock.scm" ) (load-widget 'avatar "user-avatar.scm") (load-widget 'member "member-list.scm") (load-widget 'groupbox "groupbox.scm" ) (load-widget 'layout "layout.scm") (load-widget 'knodium-page "knodium-page.scm") (load-widget 'menu-item "menu-item.scm") (define ++ string-append) (load-widget 'statusbox "statusbox.scm" ) ; (with-output-to-file "tmp.html" (lambda () (knodium-sxml->html hubs-demo-page))) (define widget-debugger-page (let* ((widget-names (map car (widgets))) (menu-items (map (lambda (name) `(menu-item (@ (id ,(symbol->string name)) (icon "home") (text ,(symbol->string name)) (href "/") ))) widget-names)) (test (pp `(layout (@ (menu-items ',menu-items))))) ;(menu-items ''((menu-item (@ (id "home") (icon "home") (text "Home") (href "/"))) ; (menu-item (@ (id "home") (icon "home") (text "Home") (href "/"))) ; )) (test (pp menu-items)) (test (pp `(layout (@ (menu-items ,menu-items))))) ) `(layout (@ (menu-items ',menu-items ;`((menu-item (@ (id "statusbox") (icon "home") (text "statusbox") (href "/"))) ; (menu-item (@ (id "menu-item") (icon "home") (text "menu-item") (href "/")))) ) (title "Widget Debugger")) (h1 "Welcome to the Knodium Widget Debugger") (groupbox (@ (title "Test")) (statusbox) ) (h1 (@ (style "clear: both;")) "---B<---") )))
menu-items.scm added by andyjpb on Thu Jun 28 19:12:57 2012
$ more menu-item.scm
`(div (@ (id ,id)
(class "menu-item"))
(a (@ (href ,href))
(div (@ (class "icon " ,icon)))
(div (@ (class "text")) ,text)))