Browse Source

Merge branch 'maint'

Nicolas Goaziou 8 years ago
parent
commit
4d9857f97b
2 changed files with 40 additions and 31 deletions
  1. 28 23
      lisp/org.el
  2. 12 8
      testing/lisp/test-org.el

+ 28 - 23
lisp/org.el

@@ -24590,29 +24590,34 @@ Move to the previous element at the same level, when possible."
 (defun org-drag-element-backward ()
   "Move backward element at point."
   (interactive)
-  (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up)
-    (let* ((elem (or (org-element-at-point)
-		     (user-error "No element at point")))
-	   (prev-elem
-	    (save-excursion
-	      (goto-char (org-element-property :begin elem))
-	      (skip-chars-backward " \r\t\n")
-	      (unless (bobp)
-		(let* ((beg (org-element-property :begin elem))
-		       (prev (org-element-at-point))
-		       (up prev))
-		  (while (and (setq up (org-element-property :parent up))
-			      (<= (org-element-property :end up) beg))
-		    (setq prev up))
-		  prev)))))
-      ;; Error out if no previous element or previous element is
-      ;; a parent of the current one.
-      (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)))))))))
+  (let ((elem (or (org-element-at-point)
+		  (user-error "No element at point"))))
+    (if (eq (org-element-type elem) 'headline)
+	;; Preserve point when moving a whole tree, even if point was
+	;; on blank lines below the headline.
+	(let ((offset (skip-chars-backward " \t\n")))
+	  (unwind-protect (org-move-subtree-up)
+	    (forward-char (- offset))))
+      (let ((prev-elem
+	     (save-excursion
+	       (goto-char (org-element-property :begin elem))
+	       (skip-chars-backward " \r\t\n")
+	       (unless (bobp)
+		 (let* ((beg (org-element-property :begin elem))
+			(prev (org-element-at-point))
+			(up prev))
+		   (while (and (setq up (org-element-property :parent up))
+			       (<= (org-element-property :end up) beg))
+		     (setq prev up))
+		   prev)))))
+	;; Error out if no previous element or previous element is
+	;; a parent of the current one.
+	(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 ()
   "Move forward element at point."

+ 12 - 8
testing/lisp/test-org.el

@@ -3267,21 +3267,18 @@ Outside."
    :type 'user-error)
   ;; Error when trying to swap nested elements.
   (should-error
-   (org-test-with-temp-text "#+BEGIN_CENTER\nTest.\n#+END_CENTER"
-     (forward-line)
+   (org-test-with-temp-text "#+BEGIN_CENTER\n<point>Test.\n#+END_CENTER"
      (org-drag-element-backward))
    :type 'user-error)
   ;; Error when trying to swap an headline element and a non-headline
   ;; element.
   (should-error
-   (org-test-with-temp-text "Test.\n* Head 1"
-     (forward-line)
+   (org-test-with-temp-text "Test.\n<point>* Head 1"
      (org-drag-element-backward))
-   :type 'user-error)
+   :type 'error)
   ;; Error when called before first element.
   (should-error
-   (org-test-with-temp-text "\n"
-     (forward-line)
+   (org-test-with-temp-text "\n<point>"
      (org-drag-element-backward))
    :type 'user-error)
   ;; Preserve visibility of elements and their contents.
@@ -3299,7 +3296,14 @@ Text.
 	    (search-backward "- item 1")
 	    (org-drag-element-backward)
 	    (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 ()
   "Test `org-drag-element-forward' specifications."