branch: externals/org
commit 0d5951a9b02d9ce71af154612d0fa3a3381856ec
Author: Ihor Radchenko <yanta...@posteo.net>
Commit: Ihor Radchenko <yanta...@posteo.net>
org-refile: Fix edge case when we refile on top of the same subtree
* lisp/org-refile.el (org-refile): Use dedicated marker (move after
insertion) to store position of the heading being refiled. Otherwise,
if refiled heading is inserted at the same point, `save-excursion'
would restore point before the inserted heading instead of keeping it
at the original heading.
* testing/lisp/test-org.el (test-org/refile): At test.
Reported-by: /u/madclassix
---
lisp/org-refile.el | 107 +++++++++++++++++++++++++----------------------
testing/lisp/test-org.el | 11 +++++
2 files changed, 69 insertions(+), 49 deletions(-)
diff --git a/lisp/org-refile.el b/lisp/org-refile.el
index 5a41c022fe..03c351cf6b 100644
--- a/lisp/org-refile.el
+++ b/lisp/org-refile.el
@@ -541,58 +541,67 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(org-kill-new (buffer-substring region-start region-end))
(org-save-markers-in-region region-start region-end))
(org-copy-subtree 1 nil t))
- (with-current-buffer (setq nbuf (or (find-buffer-visiting file)
- (find-file-noselect file)))
- (setq reversed (org-notes-order-reversed-p))
- (org-with-wide-buffer
- (if pos
- (progn
- (goto-char pos)
- (setq level (org-get-valid-level (funcall outline-level)
1))
- (goto-char
- (if reversed
- (or (outline-next-heading) (point-max))
- (or (save-excursion (org-get-next-sibling))
- (org-end-of-subtree t t)
- (point-max)))))
- (setq level 1)
- (if (not reversed)
- (goto-char (point-max))
- (goto-char (point-min))
- (or (outline-next-heading) (goto-char (point-max)))))
- (unless (bolp) (newline))
- (org-paste-subtree level nil nil t)
- ;; Record information, according to `org-log-refile'.
- ;; Do not prompt for a note when refiling multiple
- ;; headlines, however. Simply add a time stamp.
- (cond
- ((not org-log-refile))
- (regionp
- (org-map-region
- (lambda () (org-add-log-setup 'refile nil nil 'time))
- (point)
- (+ (point) (- region-end region-start))))
- (t
- (org-add-log-setup 'refile nil nil org-log-refile)))
- (and org-auto-align-tags
- (let ((org-loop-over-headlines-in-active-region nil))
- (org-align-tags)))
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-refile)))
- (when bookmark-name
- (with-demoted-errors "Bookmark set error: %S"
- (bookmark-set bookmark-name))))
- ;; If we are refiling for capture, make sure that the
- ;; last-capture pointers point here
- (when (bound-and-true-p org-capture-is-refiling)
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-capture-marker)))
+ (let ((origin (point-marker)))
+ ;; Handle special case when we refile to exactly same
+ ;; location with tree promotion/demotion. Point marker
+ ;; saved by `org-width-wide-buffer' (`save-excursion')
+ ;; will then remain before the inserted subtree in
+ ;; unexpected location.
+ (set-marker-insertion-type origin t)
+ (with-current-buffer (setq nbuf (or (find-buffer-visiting file)
+ (find-file-noselect file)))
+ (setq reversed (org-notes-order-reversed-p))
+ (org-with-wide-buffer
+ (if pos
+ (progn
+ (goto-char pos)
+ (setq level (org-get-valid-level (funcall outline-level)
1))
+ (goto-char
+ (if reversed
+ (or (outline-next-heading) (point-max))
+ (or (save-excursion (org-get-next-sibling))
+ (org-end-of-subtree t t)
+ (point-max)))))
+ (setq level 1)
+ (if (not reversed)
+ (goto-char (point-max))
+ (goto-char (point-min))
+ (or (outline-next-heading) (goto-char (point-max)))))
+ (unless (bolp) (newline))
+ (org-paste-subtree level nil nil t)
+ ;; Record information, according to `org-log-refile'.
+ ;; Do not prompt for a note when refiling multiple
+ ;; headlines, however. Simply add a time stamp.
+ (cond
+ ((not org-log-refile))
+ (regionp
+ (org-map-region
+ (lambda () (org-add-log-setup 'refile nil nil 'time))
+ (point)
+ (+ (point) (- region-end region-start))))
+ (t
+ (org-add-log-setup 'refile nil nil org-log-refile)))
+ (and org-auto-align-tags
+ (let ((org-loop-over-headlines-in-active-region nil))
+ (org-align-tags)))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-refile)))
(when bookmark-name
(with-demoted-errors "Bookmark set error: %S"
(bookmark-set bookmark-name))))
- (move-marker org-capture-last-stored-marker (point)))
- (deactivate-mark)
- (run-hooks 'org-after-refile-insert-hook)))
+ ;; If we are refiling for capture, make sure that the
+ ;; last-capture pointers point here
+ (when (bound-and-true-p org-capture-is-refiling)
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture-marker)))
+ (when bookmark-name
+ (with-demoted-errors "Bookmark set error: %S"
+ (bookmark-set bookmark-name))))
+ (move-marker org-capture-last-stored-marker (point)))
+ (deactivate-mark)
+ (run-hooks 'org-after-refile-insert-hook)))
+ ;; Go back to ORIGIN.
+ (goto-char origin))
(unless org-refile-keep
(if regionp
(delete-region (point) (+ (point) (- region-end
region-start)))
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index cd7011de12..7ed4ffd198 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -6953,6 +6953,17 @@ Paragraph<point>"
(org-refile-targets `((nil :level . 1))))
(mapcar #'car (org-refile-get-targets)))))))
+(ert-deftest test-org/refile ()
+ "Test `org-refile' specifications."
+ ;; Test edge case when we refile heading into the same location.
+ (should
+ (equal
+ "* H1
+** H2\n"
+ (org-test-with-temp-text-in-file "* H1
+* H2<point>"
+ (org-refile nil nil `("H1" ,(buffer-file-name) nil 1))
+ (buffer-string)))))
;;; Sparse trees
