Source

pico-org / org.l

Full commit

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

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