Source

pico-org / orge.l

Full commit

(setq Lines '("* ABC" "blah" "blah" "* foo"))
(setq Lines '("* h1" "blah blah blah" "** h1-1" "*** h1-1-1" "** h1-2" "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)
  (if Lines (org-parse Lines Level)))

(de org-next-sibling (Level Lines)
	(seek '((Line) (org-parse-level Line) (or (= @ 0) (> @ Level))) 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)
						HeadingParse (if (and (>= Level Until) (> Level 0)) (org-parse-heading Line Level (cdr Lines)))
						Heading (car HeadingParse)
						NextPosition (cdr HeadingParse))
			 (if (and (<= Level Until) (not (= 0 Level))) (setq Lines NIL))
	     (if (and Lines HeadingParse)
				 (prog
					 (setq Lst (cons Heading Lst))
					 (setq Lines NextPosition))
				 (setq Lines (cdr Lines)))))
       (reverse Lst)))

(printsp (org-parse Lines -1))
(bye)