Joe Bogner  committed 9c69a4c

add api to remove a node and to convert to text

  • Participants
  • Parent commits 9129299

Comments (0)

Files changed (1)

                   "CLOCKSUM", "CLOCKSUM_T", "BLOCKED", "ITEM", "FILE")))
-(de *Org-hook-parse-body NIL)
-(de *Org-hook-add-heading NIL)
+(off *Org-hook-parse-body)
+(off *Org-hook-add-heading)
 (de org-parse-level (Line)
  (- (length (split (chop Line) "*")) 1))
 (de org-parse-body (Lines)
-  (collectUntil Lines '((Line) (> (org-parse-level (if *Org-hook-parse-body (*Org-hook-parse-body Line) Line)) 0))))
+  (let Body (collectUntil Lines '((Line) (> (org-parse-level Line) 0)))
+      (if *Org-hook-parse-body (mapcar *Org-hook-parse-body Body) Body)))
 (de org-parse-children (Lines Level)
   (let Children (collectUntil Lines '((X) (= Level (org-parse-level X))))
     (if Children (org-parse Children Level))))
-(de passoc (Key Lst) (cadr (seek '((X) (= Key (car X))) Lst)))
+(de org-val (Key Lst) (cadr (seek '((X) (= Key (car X))) Lst)))
 (de org-flatten (Lst)
       (recur (Lst)
          (for Header Lst
             (link Header)
-            (recurse (passoc 'children Header))))))
+            (recurse (org-val 'children Header))))))
 (de org-header-to-text (Header)
-   (let (Name (passoc 'name Header)
-         Level (passoc 'level Header)
-         Tags (passoc 'tags Header)
+   (let (Name (org-val 'name Header)
+         Level (org-val 'level Header)
+         Tags (org-val 'tags Header)
          TagText (mapcar '((X) (if X (pack ":" X))) Tags))
-      (list (need Level "*") " " Name " " TagText)))
+      (list (need Level "*") " " Name (if TagText (pack TagText ":")))))
 (de org-to-text (Lst)
-   (make
+   (pack (make
       (let (Flat (org-flatten Lst))
          (for X Flat
-            (let (Body (passoc 'body X)
-                  Properties (passoc 'props X))
+            (let (Body (org-val 'body X)
+                  Properties (org-val 'props X))
                (link (pack (org-header-to-text X) "^J"))
                (when Properties
                   (link ":PROPERTIES:^J")
                   (for (Prop Properties Prop (cddr Prop))
                      (link ":" (car Prop) ":" " " (cadr Prop)  "^J"))
-                  (! link ":END:^J"))
+                  (link ":END:^J"))
                (for Y Body (link Y "^J"))))))))
          Tags (mapcar pack (cdr TagSplit)))
       (cons Heading Tags)))
+# returns the Special props as a list and also the body without them (not currently used)
 (de org-parse-special-props (Body)
    (let (NewBody NIL 
          Props NIL
             (for Prop Special
                (when (match (fish atom (list Prop ":" " " '@A)) LineC) 
                   (setq Matched T)
-                  (push 'Props (cons (pack Prop) @A))))
+                  (push 'Props (pack @A))
+                  (push 'Props (pack Prop)))))
             (ifn Matched (push 'NewBody Line)))
-      (cons Props (reverse NewBody)))))
+      (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) (match '(@A ~(chop ":END:")) (chop (car Line)))))
          Props (mapcar '((X) (match '(":" @A ":" " " @B) (chop X)) (list (pack @A) (pack @B)))  Properties)
          NewBody (if Properties (cdr (seek '((Line) (match '(@A ~(chop ":END:")) (chop (car Line)))) Body)) Body)
-         SpecialPropsRet (org-parse-special-props NewBody)
-         AllProps (union Props (car SpecialPropsRet))
-         NewBody (cdr SpecialPropsRet))
-   (cons AllProps NewBody)))
+         SpecialPropsRet (org-parse-special-props NewBody))
+   (list (union Props) (car SpecialPropsRet) 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)
+         Special (cadr PropertiesFunc)
+         Body (caddr 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)
+         Key (inc '*Key)
+         Heading (list 'key Key 'level Level 'name Header 'tags Tags 'special Special 'body Body 'props Properties 'children Children)
          NextPosition (org-next-sibling Level Lines))
       (if *Org-hook-add-heading (*Org-hook-add-heading Heading))
       (cons Heading NextPosition))))
 (de org-parse (Lines Until)
-  (let Lst NIL
+  (let (Lst NIL)
     (while Lines 
       (let (Line (car Lines)
             Level (org-parse-level Line)
          (setq Lines (cdr Lines)))))
        (reverse Lst)))
+(de org-parse-text (Text)
+   (let (L (split (chop Text) "^J")
+         Lines (filter prog (mapcar pack L))
+             *Key 0)
+         (org-parse Lines 0)))
+(de org-delete-by-key (Tree Key)
+   (make 
+      (recur (Tree)
+         (for X Tree
+            (unless (= (org-val 'key X) Key)
+               (link (make 
+                  (for (Prop X Prop (cddr Prop))
+                     (unless (= (car Prop) 'children)
+                        (link (car Prop))
+                        (link (cadr Prop))))
+                        (link 'children)
+                        (link (make (recurse (org-val 'children X)))))))))))
+# not implemented
+(de org-move-by-key (Tree Key Steps) NIL)
+# not implemented
+(de org-add-sibling-by-key (Tree Key Sibling) NIL)
+# not implemented
+(de org-add-promote-by-key (Tree Key) NIL)
+# not implemented
+(de org-add-demote (Tree Key) NIL)