pico-org / org.l

(de collectUntil (Lst Func)
  (let (Ret NIL) (find '((X) (if (Func X) T (push 'Ret X) NIL)) Lst) (reverse Ret)))

(de union (Lst1 Lst2)
   (filter prog (fish atom (list Lst1 Lst2))))

(de *Org-special-props
   ~(mapcar chop (list "ID", "TODO", "TAGS", "ALLTAGS", "CATEGORY", "PRIORITY", 
                  "CLOCKSUM", "CLOCKSUM_T", "BLOCKED", "ITEM", "FILE")))

(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-remove-header-prefix (Line)
   (pack (cdr (diff (chop Line) "*"))))

(de org-parse-header-text (Line)
   (let (Text (org-remove-header-prefix Line) 
         TagSplit (split (chop Text) ":")
         Heading (pack (car TagSplit))
         Tags (mapcar pack (cdr TagSplit)))
      (cons Heading Tags)))

(de org-parse-special-props (Body)
   (let (NewBody NIL 
         Props NIL
         Special *Org-special-props)
      (for Line Body
         (let (LineC (chop Line) Matched NIL)
            (for Prop Special
               (when (match (fish atom (list Prop ":" " " '@A)) LineC) 
                  (setq Matched T)
                  (push 'Props (cons (pack Prop) @A))))
            (ifn Matched (push 'NewBody Line)))
      (cons Props (reverse NewBody)))))

(de org-parse-properties (Body)
   (let  (PropertyStart (cdr (seek '((Line) (match '(@A ~(chop ":PROPERTIES:")) (chop (car Line)))) Body))
         Properties (collectUntil PropertyStart '((Line) (pre? ":END:" Line)))
         Props (mapcar '((X) (match '(":" @A ":" " " @B) (chop X)) (list (pack @A) (pack @B)))  Properties)
         NewBody (if Properties (cdr (seek '((Line) (pre? ":END:" Line)) Body)) Body)
         SpecialPropsRet (org-parse-special-props NewBody)
         AllProps (union Props (car SpecialPropsRet))
         NewBody (cdr SpecialPropsRet))
   (cons AllProps NewBody)))

(de org-parse-heading (Line Level Lines)
  (when (> Level 0)
    (let (AllBody (org-parse-body Lines)
         PropertiesFunc (org-parse-properties AllBody)
         Properties (car PropertiesFunc)
         Body (cdr PropertiesFunc)
         Children (org-parse-children Lines Level)
         ParsedHeader (org-parse-header-text Line)
         Header (car ParsedHeader)
         Tags (cdr ParsedHeader)
         Heading (list 'level Level 'name Header 'tags Tags 'body Body 'props Properties '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)
           (setq Lst (cons Heading Lst))
           (setq Lines NextPosition))
         (setq Lines (cdr Lines)))))
       (reverse Lst)))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.