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:
Nicolas Goaziou 2017-01-14 23:23:26 +01:00
parent 1f76dd1fe1
commit f0c08e3cbb
2 changed files with 40 additions and 31 deletions

View File

@ -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."

View File

@ -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."