Forráskód Böngészése

org-capture: Fix `org-capture-refile'

* lisp/org-capture.el (org-capture-refile): Preserve location of point
  when refiling.

* testing/lisp/test-org-capture.el (test-org-capture/refile): New
  test.

Reported-by: Liu Hui <liuhui1610@gmail.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/112202>
Nicolas Goaziou 8 éve
szülő
commit
7d7c38c6b1
2 módosított fájl, 49 hozzáadás és 21 törlés
  1. 21 13
      lisp/org-capture.el
  2. 28 8
      testing/lisp/test-org-capture.el

+ 21 - 13
lisp/org-capture.el

@@ -820,20 +820,28 @@ Refiling is done from the base buffer, because the indirect buffer is then
 already gone.  Any prefix argument will be passed to the refile command."
 already gone.  Any prefix argument will be passed to the refile command."
   (interactive)
   (interactive)
   (unless (eq (org-capture-get :type 'local) 'entry)
   (unless (eq (org-capture-get :type 'local) 'entry)
-    (error
-     "Refiling from a capture buffer makes only sense for `entry'-type templates"))
-  (let ((pos (point))
-	(base (buffer-base-buffer (current-buffer)))
-	(org-capture-is-refiling t)
-	(kill-buffer (org-capture-get :kill-buffer 'local)))
+    (user-error "Refiling from a capture buffer makes only sense \
+for `entry'-type templates"))
+  (let* ((base (or (buffer-base-buffer) (current-buffer)))
+	 (pos (make-marker))
+	 (org-capture-is-refiling t)
+	 (kill-buffer (org-capture-get :kill-buffer 'local)))
+    ;; Since `org-capture-finalize' may alter buffer contents (e.g.,
+    ;; empty lines) around entry, use a marker to refer to the
+    ;; headline to be refiled.  Place the marker in the base buffer,
+    ;; as the current indirect one is going to be killed.
+    (set-marker pos (save-excursion (org-back-to-heading t)) base)
     (org-capture-put :kill-buffer nil)
     (org-capture-put :kill-buffer nil)
-    (org-capture-finalize)
-    (save-window-excursion
-      (with-current-buffer (or base (current-buffer))
-	(org-with-wide-buffer
-	 (goto-char pos)
-	 (call-interactively 'org-refile))))
-    (when kill-buffer (kill-buffer base))))
+    (unwind-protect
+	(progn
+	  (org-capture-finalize)
+	  (save-window-excursion
+	    (with-current-buffer base
+	      (org-with-wide-buffer
+	       (goto-char pos)
+	       (call-interactively 'org-refile))))
+	  (when kill-buffer (kill-buffer base)))
+      (set-marker pos nil))))
 
 
 (defun org-capture-kill ()
 (defun org-capture-kill ()
   "Abort the current capture process."
   "Abort the current capture process."

+ 28 - 8
testing/lisp/test-org-capture.el

@@ -87,14 +87,34 @@
   ;; %(sexp) placeholder with an input containing the traps %, " and )
   ;; %(sexp) placeholder with an input containing the traps %, " and )
   ;; all at once which is complicated to parse.
   ;; all at once which is complicated to parse.
   (should
   (should
-   (equal
-    "5 % Less (See Item \"3)\" Somewhere)\n"
-    (let ((org-store-link-plist nil))
-      (org-capture-fill-template
-       "%(capitalize \"%i\")"
-       "5 % less (see item \"3)\" somewhere)")))))
-
-
+   (equal "5 % Less (See Item \"3)\" Somewhere)\n"
+	  (let ((org-store-link-plist nil))
+	    (org-capture-fill-template
+	     "%(capitalize \"%i\")"
+	     "5 % less (see item \"3)\" somewhere)")))))
+
+(ert-deftest test-org-capture/refile ()
+  "Test `org-capture-refile' specifications."
+  ;; When refiling, make sure the headline being refiled is the one
+  ;; being captured.  In particular, empty lines after the entry may
+  ;; be removed, and we don't want to shift onto the next heading.
+  (should
+   (string-prefix-p
+    "** H1"
+    (org-test-with-temp-text-in-file "* A\n* B\n"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Todo" entry (file+headline ,file "A") "** H1 %?"))))
+	(org-capture nil "t")
+	(insert "\n")
+	(cl-letf (((symbol-function 'org-refile)
+		   (lambda ()
+		     (interactive)
+		     (throw :return
+			    (buffer-substring-no-properties
+			     (line-beginning-position)
+			     (line-end-position))))))
+	  (catch :return (org-capture-refile))))))))
 
 
 
 
 (provide 'test-org-capture)
 (provide 'test-org-capture)