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