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 org-parse-level (Line)
 (- (length (split (chop Line) "*")) 1))

(de org-parse-body2 (Lines)
  (let (Ret '())
       (while Lines
	 (if (> (org-parse-level (car Lines)) 0)
	     (setq Lines NIL)
	   (setq Ret (cons (car Lines) Ret)))
	 (setq Lines (cdr Lines)))
			 Ret))

(de org-parse-body (Lines)
  (let (Ret)
	(for (Lines Lines Lines (cdr Lines))
	 (T (> (org-parse-level (car Lines)) 0))
	 (setq Ret (cons (car Lines) Ret)))
			 Ret))

(de org-parse-children (Lines Level)
  (if Lines (org-parse Lines Level)))

(de org-next-sibling (Level Lines)
  (let (Go Lines)
    (while (and Lines Go)
      (let (NextLevel (org-parse-level (car Lines)))
	(unless (or (= NextLevel 0) (> NextLevel Level))
	  (setq Go NIL)))
	(if Go
	  (setq Lines (cdr Lines)))))
  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 '())
       (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 HeadingParse
		 (prog
		   (setq Lst (cons Heading Lst))
		   (setq Lines NextPosition))
	       (setq Lines (cdr Lines))))))
       (reverse Lst)))

# (trace 'org-parse)
# (trace 'org-parse-children)
# (trace 'org-next-sibling)
# (trace 'org-parse-heading)

(printsp (org-parse Lines -1))








(bye)