forked from mirrors/org-mode
Fix `org-drag-element-backward' with point just below a headline
* lisp/org.el (org-drag-element-backward): When point is on empty lines below a headline, call `org-move-subtree-up'. * testing/lisp/test-org.el (test-org/drag-element-backward): Add test.
This commit is contained in:
parent
1f76dd1fe1
commit
f0c08e3cbb
51
lisp/org.el
51
lisp/org.el
|
@ -24687,29 +24687,34 @@ Move to the previous element at the same level, when possible."
|
||||||
(defun org-drag-element-backward ()
|
(defun org-drag-element-backward ()
|
||||||
"Move backward element at point."
|
"Move backward element at point."
|
||||||
(interactive)
|
(interactive)
|
||||||
(if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up)
|
(let ((elem (or (org-element-at-point)
|
||||||
(let* ((elem (or (org-element-at-point)
|
(user-error "No element at point"))))
|
||||||
(user-error "No element at point")))
|
(if (eq (org-element-type elem) 'headline)
|
||||||
(prev-elem
|
;; Preserve point when moving a whole tree, even if point was
|
||||||
(save-excursion
|
;; on blank lines below the headline.
|
||||||
(goto-char (org-element-property :begin elem))
|
(let ((offset (skip-chars-backward " \t\n")))
|
||||||
(skip-chars-backward " \r\t\n")
|
(unwind-protect (org-move-subtree-up)
|
||||||
(unless (bobp)
|
(forward-char (- offset))))
|
||||||
(let* ((beg (org-element-property :begin elem))
|
(let ((prev-elem
|
||||||
(prev (org-element-at-point))
|
(save-excursion
|
||||||
(up prev))
|
(goto-char (org-element-property :begin elem))
|
||||||
(while (and (setq up (org-element-property :parent up))
|
(skip-chars-backward " \r\t\n")
|
||||||
(<= (org-element-property :end up) beg))
|
(unless (bobp)
|
||||||
(setq prev up))
|
(let* ((beg (org-element-property :begin elem))
|
||||||
prev)))))
|
(prev (org-element-at-point))
|
||||||
;; Error out if no previous element or previous element is
|
(up prev))
|
||||||
;; a parent of the current one.
|
(while (and (setq up (org-element-property :parent up))
|
||||||
(if (or (not prev-elem) (org-element-nested-p elem prev-elem))
|
(<= (org-element-property :end up) beg))
|
||||||
(user-error "Cannot drag element backward")
|
(setq prev up))
|
||||||
(let ((pos (point)))
|
prev)))))
|
||||||
(org-element-swap-A-B prev-elem elem)
|
;; Error out if no previous element or previous element is
|
||||||
(goto-char (+ (org-element-property :begin prev-elem)
|
;; a parent of the current one.
|
||||||
(- pos (org-element-property :begin elem)))))))))
|
(if (or (not prev-elem) (org-element-nested-p elem prev-elem))
|
||||||
|
(user-error "Cannot drag element backward")
|
||||||
|
(let ((pos (point)))
|
||||||
|
(org-element-swap-A-B prev-elem elem)
|
||||||
|
(goto-char (+ (org-element-property :begin prev-elem)
|
||||||
|
(- pos (org-element-property :begin elem))))))))))
|
||||||
|
|
||||||
(defun org-drag-element-forward ()
|
(defun org-drag-element-forward ()
|
||||||
"Move forward element at point."
|
"Move forward element at point."
|
||||||
|
|
|
@ -3256,21 +3256,18 @@ Outside."
|
||||||
:type 'user-error)
|
:type 'user-error)
|
||||||
;; Error when trying to swap nested elements.
|
;; Error when trying to swap nested elements.
|
||||||
(should-error
|
(should-error
|
||||||
(org-test-with-temp-text "#+BEGIN_CENTER\nTest.\n#+END_CENTER"
|
(org-test-with-temp-text "#+BEGIN_CENTER\n<point>Test.\n#+END_CENTER"
|
||||||
(forward-line)
|
|
||||||
(org-drag-element-backward))
|
(org-drag-element-backward))
|
||||||
:type 'user-error)
|
:type 'user-error)
|
||||||
;; Error when trying to swap an headline element and a non-headline
|
;; Error when trying to swap an headline element and a non-headline
|
||||||
;; element.
|
;; element.
|
||||||
(should-error
|
(should-error
|
||||||
(org-test-with-temp-text "Test.\n* Head 1"
|
(org-test-with-temp-text "Test.\n<point>* Head 1"
|
||||||
(forward-line)
|
|
||||||
(org-drag-element-backward))
|
(org-drag-element-backward))
|
||||||
:type 'user-error)
|
:type 'error)
|
||||||
;; Error when called before first element.
|
;; Error when called before first element.
|
||||||
(should-error
|
(should-error
|
||||||
(org-test-with-temp-text "\n"
|
(org-test-with-temp-text "\n<point>"
|
||||||
(forward-line)
|
|
||||||
(org-drag-element-backward))
|
(org-drag-element-backward))
|
||||||
:type 'user-error)
|
:type 'user-error)
|
||||||
;; Preserve visibility of elements and their contents.
|
;; Preserve visibility of elements and their contents.
|
||||||
|
@ -3288,7 +3285,14 @@ Text.
|
||||||
(search-backward "- item 1")
|
(search-backward "- item 1")
|
||||||
(org-drag-element-backward)
|
(org-drag-element-backward)
|
||||||
(mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov)))
|
(mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov)))
|
||||||
(overlays-in (point-min) (point-max)))))))
|
(overlays-in (point-min) (point-max))))))
|
||||||
|
;; Pathological case: handle call with point in blank lines right
|
||||||
|
;; after a headline.
|
||||||
|
(should
|
||||||
|
(equal "* H2\n* H1\nText\n\n"
|
||||||
|
(org-test-with-temp-text "* H1\nText\n* H2\n\n<point>"
|
||||||
|
(org-drag-element-backward)
|
||||||
|
(buffer-string)))))
|
||||||
|
|
||||||
(ert-deftest test-org/drag-element-forward ()
|
(ert-deftest test-org/drag-element-forward ()
|
||||||
"Test `org-drag-element-forward' specifications."
|
"Test `org-drag-element-forward' specifications."
|
||||||
|
|
Loading…
Reference in New Issue