Skip to content

Commit

Permalink
FIX whitespace issues with headline de/promotion
Browse files Browse the repository at this point in the history
  • Loading branch information
@ndwarshuis
ndwarshuis committed Aug 3, 2024
1 parent 5807732 commit a21acad
Show file tree
Hide file tree
Showing 2 changed files with 125 additions and 17 deletions.
93 changes: 89 additions & 4 deletions dev/org-ml-examples.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5554,8 +5554,6 @@

:begin-hidden

;; make sure this works with whitespace

(:buffer "* one"
""
"** two"
Expand Down Expand Up @@ -5615,7 +5613,26 @@
=> (:result "* one"
"** two"
"*** three"
"**** four"))
"**** four")
:begin-hidden
(:buffer "* one"
""
"** two"
""
"** three"
""
"*** four")
(org-ml->> (org-ml-parse-element-at 1)
(org-ml-headline-demote-subtree 1)
(org-ml-to-trimmed-string))
=> (:result "* one"
""
"** two"
""
"*** three"
""
"**** four")
:end-hidden)

(defexamples-content org-ml-headline-promote-subheadline
nil
Expand All @@ -5633,7 +5650,52 @@
"** three"
"*** four"
"** four"
"*** four"))
"*** four")
:begin-hidden
(:buffer "* one"
"** two"
"** three"
"*** four"
"*** four"
"**** five"
"*** four")
(org-ml->> (org-ml-parse-element-at 1)
(org-ml-headline-promote-subheadline 1 1)
(org-ml-to-trimmed-string))
=> (:result "* one"
"** two"
"** three"
"*** four"
"** four"
"*** five"
"*** four")
;; TODO this is a whitespace bug in 9.7
;; (:buffer "* one"
;; ""
;; "** two"
;; ""
;; "** three"
;; ""
;; "*** four"
;; ""
;; "*** four"
;; ""
;; "*** four")
;; (org-ml->> (org-ml-parse-element-at 1)
;; (org-ml-headline-promote-subheadline 1 1)
;; (org-ml-to-trimmed-string))
;; => (:result "* one"
;; ""
;; "** two"
;; ""
;; "** three"
;; ""
;; "*** four"
;; ""
;; "** four"
;; ""
;; "*** four")
:end-hidden)

(defexamples-content org-ml-headline-promote-all-subheadlines
nil
Expand Down Expand Up @@ -5698,6 +5760,29 @@
"- two"
" - three"
" - four"))
;; :begin-hidden
;; (:buffer "- one"
;; ""
;; "- two"
;; ""
;; " - three"
;; ""
;; "- four"
;; ""
;; " - five")
;; (org-ml->> (org-ml-parse-element-at 1)
;; (org-ml-plain-list-indent-item 2)
;; (org-ml-to-trimmed-string))
;; => (:result "- one"
;; ""
;; "- two"
;; ""
;; " - three"
;; ""
;; " - four"
;; ""
;; " - five")
;; :end-hidden)

(defexamples-content org-ml-plain-list-indent-item-tree
nil
Expand Down
49 changes: 36 additions & 13 deletions org-ml.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5682,9 +5682,20 @@ Unlike `org-ml-headline-demote-subheadline' this will also demote the
demoted headline node's children."
(org-ml-headline-map-subheadlines*
(org-ml--tree-set-child* index
(org-ml--map-children-nocheck*
(-snoc it (org-ml--headline-subtree-shift-level 1 it-target))
it)
(let ((parent-headline (if (org-element-contents it) it
;; special case, if the parent headline has
;; nothing underneath it, set the post blank to
;; the pre blank so that any spacing will be
;; preserved when we set the target as its
;; subheadline
(let ((pre (org-element-property :pre-blank it))
(post (org-element-post-blank it)))
(org-ml--set-properties-raw (org-ml-copy it)
:pre-blank (+ pre post)
:post-blank 0)))))
(org-ml--map-children-nocheck*
(-snoc it (org-ml--headline-subtree-shift-level 1 it-target))
parent-headline))
it)
headline))

Expand All @@ -5702,10 +5713,17 @@ demoted headline node's children."
(tgt-headline* (->> (org-ml-copy it-target)
(org-ml-headline-set-subheadlines nil)
(org-ml--headline-shift-level 1)
(org-ml--set-post-blank tgt-pb))))
(org-ml--set-post-blank tgt-pb)))
;; TODO not DRY
(parent-headline (if (org-element-contents it) it
(let ((pre (org-element-property :pre-blank it))
(post (org-element-post-blank it)))
(org-ml--set-properties-raw (org-ml-copy it)
:pre-blank (+ pre post)
:post-blank 0)))))
(org-ml--map-children-nocheck*
(append it (list tgt-headline*) headlines-in-target)
it))
parent-headline))
it)
headline))

Expand Down Expand Up @@ -5738,9 +5756,7 @@ item node's children."
(apply #'org-ml-build-plain-list :post-blank pb)
(list))))
(list h* i* pb* (append r* pl r)))
(--> (org-ml--map-last*
(org-ml--map-property-raw* :post-blank (+ it pb*) it)
i*)
(--> (org-ml--map-last* (org-ml--shift-post-blank pb* it) i*)
(list h* (append it (list tgt-item*) i) pb r))))
it))
it)
Expand Down Expand Up @@ -5789,10 +5805,17 @@ CHILDREN nodes after PARENT at the same level as PARENT."
"Return HEADLINE node with all child headlines under INDEX promoted."
(org-ml-headline-map-subheadlines*
(org-ml--split-children-at-index* index
(let ((children (->> (org-element-contents it)
(--map (org-ml--headline-subtree-shift-level -1 it))))
(parent (org-ml--set-children-nocheck nil it)))
(list parent children))
(let* ((children (->> (org-element-contents it)
(--map (org-ml--headline-subtree-shift-level -1 it))))
(parent (org-ml--set-children-nocheck nil it))
;; TODO not DRY
(parent* (if children parent
(let ((pre (org-element-property :pre-blank parent))
(post (org-element-post-blank parent)))
(org-ml--set-properties-raw (org-ml-copy parent)
:pre-blank (+ pre post)
:post-blank 0)))))
(list parent* children))
it)
headline))

Expand Down Expand Up @@ -5845,7 +5868,7 @@ The specific child headline to promote is selected by CHILD-INDEX."
(-let* (((head tail) (-split-at child-index (org-element-contents it)))
(target (->> (car tail)
(org-ml-copy)
(org-ml--headline-shift-level -1)
(org-ml--headline-subtree-shift-level -1)
(org-ml-headline-map-subheadlines*
(append it (cdr tail)))))
(parent (org-ml--set-children-nocheck head it)))
Expand Down

0 comments on commit a21acad

Please sign in to comment.