Commits

Joe Bogner committed da42eb2

initial commit with new files

Comments (0)

Files changed (5)

+<html>
+{{#org}}
+<h{{level}}>{{name}}</h{{level}}>
+{{#body}}
+{{.}}<br>
+{{/body}}
+{{#children}}{{#orgt}}{{/orgt}}{{/children}}
+{{/org}}
+(load "@lib/http.l")
+(load "org.l")
+(load "picostache.l")
+
+(de readLines (File)
+	(filter '((X) X)(make
+		(in File
+ 			 (until (eof)
+				 (link (pack (line))))))))
+
+(de passoc (Key Lst) (cadr (seek '((X) (= Key (car X))) Lst)))
+(setq lookup passoc) #hack to override picostache to use plists
+
+(de start() 
+	(let (Html (pack (readLines "org-html.html"))
+				TemplateTree (parse Html)
+				Lines (readLines "example.org.bak")
+				Org (org-parse Lines 0)
+				Model (cons 'org (list Org)))
+
+				(push 'Model '((X) (if View (renderTree (cons 'org (list (list View))) TemplateTree))))
+				(push 'Model 'orgt)
+				(prinl (renderTree Model TemplateTree))))
+
+(de go ()
+ (server 21000 "!start") )
+(setq Lines '("* ABC" "blah" "blah" "* foo"))
+(setq Lines '("* h1" "blah blah blah" "more" "** h1-1" "body" "* h2" "** h2-1" "asdfasdf" "* h3"))
+(setq Lines '("* h1" "blah blah blah" "more" "** h1-1" "body2" "*** h3" "more body"))
+
+
+(de collectUntil (Lst Func)
+	(let (Ret NIL) (find '((X) (if (Func X) T (push 'Ret X) NIL)) Lst) (reverse Ret)))
+
+(de org-parse-level (Line)
+ (- (length (split (chop Line) "*")) 1))
+
+(de org-parse-body (Lines)
+	(collectUntil Lines '((Line) (> (org-parse-level Line) 0))))
+
+(de org-parse-children (Lines Level)
+	(let Children (collectUntil Lines '((X) (= Level (org-parse-level X))))
+  	(if Children (org-parse Children Level))))
+
+(de org-next-sibling (Level Lines)
+	(seek '((Line) (= Level (org-parse-level (car Line)))) Lines))
+
+(de org-parse-heading (Line Level Lines)
+  (when (> Level 0)
+    (let (Body (org-parse-body Lines)
+				 Children (org-parse-children Lines Level)
+				 Heading (list 'level Level 'name Line 'body Body 'children Children)
+				 NextPosition (org-next-sibling Level Lines))
+		 (cons Heading NextPosition))))
+
+(de org-parse (Lines Until)
+	(let Lst NIL
+		(while Lines 
+			(let (Line (car Lines)
+						Level (org-parse-level Line)
+						IsBody (= 0 Level)
+						Sibling (<= Level Until)
+						ShouldParse (and (not Sibling) (not IsBody)) 
+						ParsedHeading (if ShouldParse (org-parse-heading Line Level (cdr Lines)))
+						Heading (car ParsedHeading)
+						NextPosition (cdr ParsedHeading))
+			 (if (and Sibling (not IsBody)) (setq Lines NIL))
+	     (if (and Lines ParsedHeading)
+				 (prog
+					 (setq Lst (cons Heading Lst))
+					 (setq Lines NextPosition))
+				 (setq Lines (cdr Lines)))))
+       (reverse Lst)))
+
+(de testing ()
+	(setq Org (org-parse Lines 0))
+	(printsp Org)
+
+
+	(load "picostache.l")
+
+	(setq Lines (make
+	(in "example.org.bak"
+	 (until (eof)
+		 (link (pack (line)))))))
+
+	(setq Org (org-parse Lines 0))
+	(de passoc (Key Lst) (cadr (seek '((X) (= Key (car X))) Lst)))
+	(setq lookup passoc)
+
+	(setq Model (cons 'org (list Org)))
+	(setq Model (cons '((X) (if View (renderTree (cons 'org (list (list View))) *Tree))) Model))
+	(setq Model (cons 'orgt  Model))
+
+	(printsp Org)
+	(prinl)
+	(prinl)
+	(setq *Tree (parse "{{#org}}{{name}}^J{{#body}}{{.}}^J{{/body}}{{#children}}{{#orgt}}{{/orgt}} ^J{{/children}}{{/org}}"))
+	# (setq *Tree (parse "{{#org}}{{name}}^J{{{#children}}{{#orgt}}{{/#orgt}} ^j{{/children}}{{/org}}"))
+	(setq *Tree (parse "{{#org}}HEADING!!!  -- level {{level}} {{name}}^J{{#body}}{{.}}^J{{/body}}{{#children}}{{#orgt}}{{/orgt}}{{/children}}{{/org}}"))
+	# (setq *Tree '((Section "org" (Name "name") (Text "^J") (Section "body" (Name ".") (Text "^J")) (Section "children" (Section "orgt")))))
+	(prinl (renderTree Model *Tree)))

orge.l

-
-(setq Lines '("* ABC" "blah" "blah" "* foo"))
-(setq Lines '("* h1" "blah blah blah" "** h1-1" "* h3" "** h3-1" "asdfasdf" "* h2"))
-
-
-
-(de collectUntil (Lst Func)
-	(let (Ret NIL) (find '((X) (if (Func X) T (push 'Ret X) NIL)) Lst) (reverse Ret)))
-
-(de org-parse-level (Line)
- (- (length (split (chop Line) "*")) 1))
-
-(de org-parse-body (Lines)
-	(collectUntil Lines '((Line) (> (org-parse-level Line) 0))))
-
-(de org-parse-children (Lines Level)
-	(let Children (collectUntil Lines '((X) (= Level (org-parse-level X))))
-  	(if Children (org-parse Children Level))))
-
-(de org-next-sibling (Level Lines)
-	(seek '((Line) (= Level (org-parse-level (car Line)))) Lines))
-
-(de org-parse-heading (Line Level Lines)
-  (when (> Level 0)
-    (let (Body (org-parse-body Lines)
-				 Children (org-parse-children Lines Level)
-				 Heading (list 'name Line 'body Body 'children Children)
-				 NextPosition (org-next-sibling Level Lines))
-		 (cons Heading NextPosition))))
-
-(de org-parse (Lines Until)
-	(let Lst NIL
-		(while Lines 
-			(let (Line (car Lines)
-						Level (org-parse-level Line)
-						IsBody (= 0 Level)
-						Sibling (<= Level Until)
-						ShouldParse (and (not Sibling) (not IsBody)) 
-						ParsedHeading (if ShouldParse (org-parse-heading Line Level (cdr Lines)))
-						Heading (car ParsedHeading)
-						NextPosition (cdr ParsedHeading))
-			 (if (and Sibling (not IsBody)) (setq Lines NIL))
-	     (if (and Lines ParsedHeading)
-				 (prog
-					 (setq Lst (cons Heading Lst))
-					 (setq Lines NextPosition))
-				 (setq Lines (cdr Lines)))))
-       (reverse Lst)))
-
-(printsp (org-parse Lines 0))
-
-
+# picostache.l Tiny mustache template implementation
+# (c) 2012 Joe Bogner 
+# https://bitbucket.org/joebo/picostache/
+
+(default *DELIM_S (chop "{{") *DELIM_E (chop "}}"))
+
+(de lookup (Key Model)
+	(cdr (assoc Key Model)))
+
+(de context (View Key)
+    (setq Func (lookup Key Model))
+    (if (pair (fun? Func))
+        (Func View)
+        (if (= Key ".")
+            View
+            (lookup Key View) ) ) )
+
+(de section (View Key Rest Inverted)
+    (setq Func (lookup Key Model))
+    (if (pair (fun? Func))
+        (link (Func (pack (make (render View Rest)))))
+        (setq Subview (context View Key))
+        (ifn Inverted 
+            (for X Subview (render X Rest))
+            (if (not Subview) (render X Rest) ))))
+
+(de render (View Tree)
+    (for X Tree 
+        (case (car X) 
+            (Name (link (context View (cadr X))))
+            (Text (link (cdr X)))
+            (Section (section View (cadr X) (cddr X)))
+            (NonSection (section View (cadr X) (cddr X) T)))
+        (if (pair (cadr X)) (render View (cdr X))) ) ) 
+
+(de renderTree (View Tree)
+    (pack (make (render View Tree))) )
+
+(de renderHtml (View Html)
+    (renderTree View (parse Html)) )
+
+(de headUntil (Lst Delim)
+   (make  
+        (let DelimLen (length Delim)
+            (for (C Lst C (cdr C))
+                (ifn (= Delim (head DelimLen C))
+                    (link (car C))
+                    (setq C NIL) ) ) ) ) )  
+
+(de addCell (Type Cell Force)
+    (when (or Force (<> CurType Type)) 
+        (if CurType (queue RootPtr (list CurType (pack (reverse Cur)))))
+        (when (or (= CurType "Section") (= CurType "NonSection")) 
+						(push 'Levels (last (car RootPtr)))
+            (setq RootPtr (list (last (car RootPtr)))))
+        (setq CurType Type)
+        (setq Cur NIL) )
+    (push 'Cur Cell))  
+
+(de parse (Html)
+    (setq Root (list))
+    (setq RootPtr Root)
+    (setq Cur NIL)
+		(setq Levels NIL)
+    (for (C (chop Html) C (cdr C))
+        (ifn (= *DELIM_S (head 2 C))
+            (addCell 'Text (car C))
+            (let (TokenStart (nth C 3) Token (headUntil TokenStart *DELIM_E))
+                (case (car Token)
+                    ("#" (addCell 'Section (cdr Token) T)) 
+                    ("~" (addCell 'NonSection (cdr Token) T)) 
+                    ("/" (addCell NIL (cdr Token) T ) (pop 'Levels) (setq RootPtr Levels))
+                    (T (addCell 'Name Token T)) )
+                (setq C (nth C (+ (length *DELIM_S) (length Token) (length *DELIM_E))))) ) ) 
+    (addCell NIL NIL T)
+    (car Root) )
+
+(de testParse ()
+    (setq Html "hello {{name}}{{#names}}^J- {{.}}{{/#names}}")
+    (setq Template (parse Html))
+    (setq Expected '((Text "hello ") (Name "name") (Section "names" (Text "^J- ") (Name "."))))
+    (test Expected Template)
+    (push 'Model (cons "name" "joe"))
+    (setq Names '(names . ("joe" "bob" "frank")))
+    (push 'Model Names)
+    (test "hello joe^J- joe^J- bob^J- frank" (renderTree Model Template)) 
+    (test "sleep,eat," (renderHtml '((todos ((todo . "sleep")) ((todo . "eat")))) "{{#todos}}{{todo}},{{/todos}}"))
+)
+
+(de testRender ()
+    (setq Tree (quote 
+        (Text "hello ") 
+        (Name "name") 
+        (Text "^J") 
+        (NonSection "missing" (Text "nothing here^J")) 
+        (Section "names" (Text " - ") (Section "Upper" (Name ".")) (Text "^J"))))
+    (push 'Model (cons "name" "joe"))
+    (setq Names '(names . ("joe" "bob" "frank")))
+    (push 'Model Names)
+    (push 'Model (cons "Upper" '((X) (uppc X))))
+    (test "hello joe^Jnothing here^J - JOE^J - BOB^J - FRANK^J" (renderTree Model Tree)) 
+) 
+
+
+# (testRender)
+# (testParse)