[PATCH] org: Support creating arbitrary headline paths when refiling

[PATCH] org: Support creating arbitrary headline paths when refiling

[Sebastian Reuße]

* org.el (org--refile-new-path): Add.
(org-refile): Use it.
(org-refile-new-child): Make new nodes more compact.

* test-org.el (test-org/org-refile): Add test.

While ‘org-refile’ currently supports creating new headlines when
refiling, only one single headline can be created this way. For
convenience, we now generalize this use-case to support creating
arbitrary headline paths on the fly.
---
 lisp/org.el              | 35 ++++++++++++++++++++-------------
 testing/lisp/test-org.el | 42 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 64 insertions(+), 13 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index 8aa16bfd5..2af144418 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11468,17 +11468,12 @@ (defun org-refile-get-location (&optional prompt default-buffer new-nodes)
 	    (when (equal (car org-refile-history) (nth 1 org-refile-history))
 	      (pop org-refile-history)))
 	  pa)
-      (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
-	  (progn
-	    (setq parent (match-string 1 answ)
-		  child (match-string 2 answ))
-	    (setq parent-target (org-refile--get-location parent tbl))
-	    (when (and parent-target
-		       (or (eq new-nodes t)
-			   (and (eq new-nodes 'confirm)
-				(y-or-n-p (format "Create new node \"%s\"? "
-						  child)))))
-	      (org-refile-new-child parent-target child)))
+      (if (and (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
+	       (or (eq new-nodes t)
+		   (and (eq new-nodes 'confirm)
+			(y-or-n-p (format "Create new path \"%s\"? "
+					  answ)))))
+	  (org--refile-new-path answ tbl)
 	(user-error "Invalid target location")))))
 
 (declare-function org-string-nw-p "org-macs" (s))
@@ -11502,6 +11497,20 @@ (defun org-refile-check-position (refile-pointer)
 	   (unless (looking-at-p re)
 	     (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
 
+(defun org--refile-new-path (path tbl)
+  "Ensure that all parent nodes leading to refile target PATH exist.
+
+Use TBL as a look-up table for existing nodes.
+
+Return the corresponding refile location."
+  (let ((target (org-refile--get-location path tbl)))
+    (if (and (not target)
+	     (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" path))
+	(let ((child (match-string 2 path))
+	      (parent (org--refile-new-path (match-string 1 path) tbl)))
+	  (org-refile-new-child parent child))
+      target)))
+
 (defun org-refile-new-child (parent-target child)
   "Use refile target PARENT-TARGET to add new CHILD below it."
   (unless parent-target
@@ -11520,8 +11529,8 @@ (defun org-refile-new-child (parent-target child)
 	 (setq level (funcall outline-level))
 	 (org-end-of-subtree t t))
        (org-back-over-empty-lines)
-       (insert "\n" (make-string
-		     (if pos (org-get-valid-level level 1) 1) ?*)
+       (insert (make-string
+		(if pos (org-get-valid-level level 1) 1) ?*)
 	       " " child "\n")
        (beginning-of-line 0)
        (list (concat (car parent-target) "/" child) file "" (point))))))
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 20164beb5..4036db92b 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -5789,6 +5789,48 @@
 	    (org-refile-targets `((nil :level . 1))))
        (member (buffer-name) (mapcar #'car (org-refile-get-targets)))))))
 
+(ert-deftest test-org/org-refile ()
+  "Test `org-refile' specifications."
+  ;; Create new parent nodes via `org--refile-new-path'.
+  (let* ((low-calorie-buffer "* Cake
+** Topping
+*** Rainbow chocolates
+*** Pistachio icing
+** Filling
+*** Banana ice cream
+*** Cookie dough
+*** Crispy crunch
+* Extra Ingredients
+** Marshmallows
+")
+	 (low-calorie-buffer-target "* Cake
+** Topping
+*** Rainbow chocolates
+*** Pistachio icing
+** Filling
+*** Banana ice cream
+*** Cookie dough
+*** Crispy crunch
+** Bottom
+*** Base
+**** Marshmallows
+* Extra Ingredients
+")
+	 (cursor-after "Marshmallows")
+	 (refile-target "Cake/Bottom/Base")
+	 (org-refile-use-outline-path t)
+	 (org-refile-targets nil)
+	 (org-refile-allow-creating-parent-nodes t))
+    (should
+     (equal
+      (org-test-with-temp-text-in-file low-calorie-buffer
+	(re-search-forward cursor-after)
+	(cl-letf (((symbol-function 'completing-read)
+		   (lambda (&rest args) refile-target)))
+	  (call-interactively #'org-refile))
+	(buffer-string))
+      low-calorie-buffer-target))))
+
 
 \f
 ;;; Sparse trees
-- 
2.19.0

Re: [PATCH] org: Support creating arbitrary headline paths when refiling

[Nicolas Goaziou]

Hello,

Sebastian Reuße <seb@wirrsal.net> writes:

> * org.el (org--refile-new-path): Add.
> (org-refile): Use it.
> (org-refile-new-child): Make new nodes more compact.
>
> * test-org.el (test-org/org-refile): Add test.
>
> While ‘org-refile’ currently supports creating new headlines when
> refiling, only one single headline can be created this way. For
> convenience, we now generalize this use-case to support creating
> arbitrary headline paths on the fly.

Compiling your patch generates the following warnings.

    org.el:11417:1:Warning: Unused lexical variable ‘parent’
    org.el:11417:1:Warning: Unused lexical variable ‘child’
    org.el:11417:1:Warning: Unused lexical variable ‘parent-target’

Also, I couldn't test it because completing asks for a mandatory match
among candidates. Such a match is not possible if you need to create
a path out of the blue. Am I missing something?

Regards,

-- 
Nicolas Goaziou

[PATCH] org: Support creating arbitrary headline paths when refiling

[Sebastian Reuße]

* org.el (org--refile-new-path): Add.
(org-refile): Use it.
(org-refile-new-child): Make new nodes more compact.

* test-org.el (test-org/org-refile): Add test.

While ‘org-refile’ currently supports creating new headlines when
refiling, only one single headline can be created this way. For
convenience, we now generalize this use-case to support creating
arbitrary headline paths on the fly.
---
 lisp/org.el              | 37 +++++++++++++++++++++--------------
 testing/lisp/test-org.el | 42 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 65 insertions(+), 14 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index e3866c2c0..b81a58e4e 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11450,7 +11450,7 @@ (defun org-refile-get-location (&optional prompt default-buffer new-nodes)
 				  (concat " (default " (car org-refile-history) ")"))
 			     (and (assoc cbnex tbl) (setq cdef cbnex)
 				  (concat " (default " cbnex ")"))) ": "))
-	 pa answ parent-target child parent old-hist)
+	 pa answ old-hist)
     (setq old-hist org-refile-history)
     (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
 			nil 'org-refile-history (or cdef (car org-refile-history))))
@@ -11467,17 +11467,12 @@ (defun org-refile-get-location (&optional prompt default-buffer new-nodes)
 	    (when (equal (car org-refile-history) (nth 1 org-refile-history))
 	      (pop org-refile-history)))
 	  pa)
-      (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
-	  (progn
-	    (setq parent (match-string 1 answ)
-		  child (match-string 2 answ))
-	    (setq parent-target (org-refile--get-location parent tbl))
-	    (when (and parent-target
-		       (or (eq new-nodes t)
-			   (and (eq new-nodes 'confirm)
-				(y-or-n-p (format "Create new node \"%s\"? "
-						  child)))))
-	      (org-refile-new-child parent-target child)))
+      (if (and (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
+	       (or (eq new-nodes t)
+		   (and (eq new-nodes 'confirm)
+			(y-or-n-p (format "Create new path \"%s\"? "
+					  answ)))))
+	  (org--refile-new-path answ tbl)
 	(user-error "Invalid target location")))))
 
 (declare-function org-string-nw-p "org-macs" (s))
@@ -11501,6 +11496,20 @@ (defun org-refile-check-position (refile-pointer)
 	   (unless (looking-at-p re)
 	     (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
 
+(defun org--refile-new-path (path tbl)
+  "Ensure that all parent nodes leading to refile target PATH exist.
+
+Use TBL as a look-up table for existing nodes.
+
+Return the corresponding refile location."
+  (let ((target (org-refile--get-location path tbl)))
+    (if (and (not target)
+	     (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" path))
+	(let ((child (match-string 2 path))
+	      (parent (org--refile-new-path (match-string 1 path) tbl)))
+	  (org-refile-new-child parent child))
+      target)))
+
 (defun org-refile-new-child (parent-target child)
   "Use refile target PARENT-TARGET to add new CHILD below it."
   (unless parent-target
@@ -11519,8 +11528,8 @@ (defun org-refile-new-child (parent-target child)
 	 (setq level (funcall outline-level))
 	 (org-end-of-subtree t t))
        (org-back-over-empty-lines)
-       (insert "\n" (make-string
-		     (if pos (org-get-valid-level level 1) 1) ?*)
+       (insert (make-string
+		(if pos (org-get-valid-level level 1) 1) ?*)
 	       " " child "\n")
        (beginning-of-line 0)
        (list (concat (car parent-target) "/" child) file "" (point))))))
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 3f5aa09e4..93ca2bc90 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -5789,6 +5789,48 @@
 	    (org-refile-targets `((nil :level . 1))))
        (member (buffer-name) (mapcar #'car (org-refile-get-targets)))))))
 
+(ert-deftest test-org/org-refile ()
+  "Test `org-refile' specifications."
+  ;; Create new parent nodes via `org--refile-new-path'.
+  (let* ((low-calorie-buffer "* Cake
+** Topping
+*** Rainbow chocolates
+*** Pistachio icing
+** Filling
+*** Banana ice cream
+*** Cookie dough
+*** Crispy crunch
+* Extra Ingredients
+** Marshmallows
+")
+	 (low-calorie-buffer-target "* Cake
+** Topping
+*** Rainbow chocolates
+*** Pistachio icing
+** Filling
+*** Banana ice cream
+*** Cookie dough
+*** Crispy crunch
+** Bottom
+*** Base
+**** Marshmallows
+* Extra Ingredients
+")
+	 (cursor-after "Marshmallows")
+	 (refile-target "Cake/Bottom/Base")
+	 (org-refile-use-outline-path t)
+	 (org-refile-targets nil)
+	 (org-refile-allow-creating-parent-nodes t))
+    (should
+     (equal
+      (org-test-with-temp-text-in-file low-calorie-buffer
+	(re-search-forward cursor-after)
+	(cl-letf (((symbol-function 'completing-read)
+		   (lambda (&rest args) refile-target)))
+	  (call-interactively #'org-refile))
+	(buffer-string))
+      low-calorie-buffer-target))))
+
 
 \f
 ;;; Sparse trees
-- 
2.19.1

Re: [PATCH] org: Support creating arbitrary headline paths when refiling

[Sebastian Reuße]

Hello Nicolas,

Nicolas Goaziou <mail@nicolasgoaziou.fr> writes:

> Compiling your patch generates the following warnings.
>
>     org.el:11417:1:Warning: Unused lexical variable ‘parent’
>     org.el:11417:1:Warning: Unused lexical variable ‘child’
>     org.el:11417:1:Warning: Unused lexical variable 
>     ‘parent-target’

Good catch, thanks. I forgot to remove these let-bindings when 
factoring the respective ‘org-refile’ branch into a separate 
function. I amended the commit correspondingly.

> Also, I couldn't test it because completing asks for a mandatory 
> match
> among candidates. Such a match is not possible if you need to 
> create
> a path out of the blue. Am I missing something?

Do you have ‘org-refile-allow-creating-parent-nodes’ set to an 
appropriate value? When non-nil, ‘org-refile’ should invoke the 
completing read function without requiring a full match.

Kind regards,

SR

-- 
Insane cobra split the wood
Trader of the lowland breed
Call a jittney, drive away
In the slipstream we will stay

Re: [PATCH] org: Support creating arbitrary headline paths when refiling

[Sebastian Reuße]

Sebastian Reuße <seb@wirrsal.net> writes:

> +      (if (and (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)

I realize this is overly restrictive if you don’t have 
‘org-refile-use-outline-path’ set to ‘file’ and want to refile 
under a newly created root headline. AFAICT this would also have 
been an issue in the current master branch, prior to the patch.

I’m going to lift this assumption a bit and extend the test case 
for other values of ‘…-use-outline-path’.

If you notice anything in the mean time let me know.

Kind regards,

S.

-- 
Insane cobra split the wood
Trader of the lowland breed
Call a jittney, drive away
In the slipstream we will stay

[PATCH] org: Support creating arbitrary headline paths when refiling

[Sebastian Reuße]

* org.el (org--refile-new-path): Add.
(org-refile): Use it.
(org-refile-new-child): Support creating new root nodes.

* test-org.el (test-org/org-refile): Add test.

While ‘org-refile’ currently supports creating new headlines when
refiling, only one single headline can be created this way. For
convenience, we now generalize this use-case to support creating
arbitrary headline paths on the fly.
---
 lisp/org.el              | 75 ++++++++++++++++++++++++----------------
 testing/lisp/test-org.el | 66 +++++++++++++++++++++++++++++++++++
 2 files changed, 112 insertions(+), 29 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index e3866c2c0..dd82b005a 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11450,7 +11450,7 @@ (defun org-refile-get-location (&optional prompt default-buffer new-nodes)
 				  (concat " (default " (car org-refile-history) ")"))
 			     (and (assoc cbnex tbl) (setq cdef cbnex)
 				  (concat " (default " cbnex ")"))) ": "))
-	 pa answ parent-target child parent old-hist)
+	 pa answ old-hist)
     (setq old-hist org-refile-history)
     (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
 			nil 'org-refile-history (or cdef (car org-refile-history))))
@@ -11467,17 +11467,11 @@ (defun org-refile-get-location (&optional prompt default-buffer new-nodes)
 	    (when (equal (car org-refile-history) (nth 1 org-refile-history))
 	      (pop org-refile-history)))
 	  pa)
-      (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
-	  (progn
-	    (setq parent (match-string 1 answ)
-		  child (match-string 2 answ))
-	    (setq parent-target (org-refile--get-location parent tbl))
-	    (when (and parent-target
-		       (or (eq new-nodes t)
-			   (and (eq new-nodes 'confirm)
-				(y-or-n-p (format "Create new node \"%s\"? "
-						  child)))))
-	      (org-refile-new-child parent-target child)))
+      (if (or (eq new-nodes t)
+	      (and (eq new-nodes 'confirm)
+		   (y-or-n-p (format "Create new path \"%s\"? "
+				     answ))))
+	  (org--refile-new-path answ tbl)
 	(user-error "Invalid target location")))))
 
 (declare-function org-string-nw-p "org-macs" (s))
@@ -11501,29 +11495,52 @@ (defun org-refile-check-position (refile-pointer)
 	   (unless (looking-at-p re)
 	     (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
 
+(defun org--refile-new-path (path tbl)
+  "Ensure that all parent nodes leading to refile target PATH exist.
+
+Use TBL as a look-up table for existing nodes.
+
+Return the corresponding refile location."
+  (let ((target (org-refile--get-location path tbl)))
+    (or target
+	(let (parent child)
+	  (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" path)
+	      (progn
+		(setq child (match-string 2 path))
+		(setq parent (org--refile-new-path (match-string 1 path) tbl)))
+	    (setq child path))
+	  (org-refile-new-child parent child)))))
+
+
 (defun org-refile-new-child (parent-target child)
-  "Use refile target PARENT-TARGET to add new CHILD below it."
-  (unless parent-target
-    (error "Cannot find parent for new node"))
-  (let ((file (nth 1 parent-target))
-	(pos (nth 3 parent-target))
-	level)
+  "Use refile target PARENT-TARGET to add new CHILD below it.
+
+When PARENT-TARGET is ‘nil’, child will be added below the
+outline root of the current file."
+  (let (file pos)
+    (if parent-target
+	(progn
+	  (setq file (nth 1 parent-target))
+	  (setq pos (nth 3 parent-target)))
+      (setq file (buffer-file-name)))
     (with-current-buffer (or (find-buffer-visiting file)
 			     (find-file-noselect file))
       (org-with-wide-buffer
        (if pos
-	   (goto-char pos)
+	   (progn
+	     (goto-char pos)
+	     (org-insert-heading-respect-content)
+	     (org-do-demote))
+	 ;; New node is top-level
 	 (goto-char (point-max))
-	 (unless (bolp) (newline)))
-       (when (looking-at org-outline-regexp)
-	 (setq level (funcall outline-level))
-	 (org-end-of-subtree t t))
-       (org-back-over-empty-lines)
-       (insert "\n" (make-string
-		     (if pos (org-get-valid-level level 1) 1) ?*)
-	       " " child "\n")
-       (beginning-of-line 0)
-       (list (concat (car parent-target) "/" child) file "" (point))))))
+	 (unless (bolp) (newline))
+	 (org-insert-heading nil t t))
+       (insert child)
+       (beginning-of-line)
+       (list (if parent-target
+		 (format "%s/%s" (car parent-target) child)
+	       child)
+	     file "" (point))))))
 
 (defun org-olpath-completing-read (prompt collection &rest args)
   "Read an outline path like a file name."
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 3f5aa09e4..cc06e2936 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -5789,6 +5789,72 @@
 	    (org-refile-targets `((nil :level . 1))))
        (member (buffer-name) (mapcar #'car (org-refile-get-targets)))))))
 
+(ert-deftest test-org/org-refile ()
+  "Test `org-refile' specifications."
+  ;; Create new parent nodes via `org--refile-new-path'.
+  (let* ((low-calorie-buffer "* Cake
+** Topping
+*** Rainbow chocolates
+*** Pistachio icing
+** Filling
+*** Banana ice cream
+*** Cookie dough
+*** Crispy crunch
+* Extra Ingredients
+** Marshmallows
+")
+	 (low-calorie-buffer-target "* Cake
+** Topping
+*** Rainbow chocolates
+*** Pistachio icing
+** Filling
+*** Banana ice cream
+*** Cookie dough
+*** Crispy crunch
+** Bottom
+*** Base
+**** Marshmallows
+* Extra Ingredients
+")
+	 (cursor-after "Marshmallows")
+	 (refile-target "Cake/Bottom/Base")
+	 (org-refile-use-outline-path t)
+	 (org-refile-targets nil)
+	 (org-refile-allow-creating-parent-nodes t))
+    (should
+     (equal
+      (org-test-with-temp-text-in-file low-calorie-buffer
+	(re-search-forward cursor-after)
+	(cl-letf (((symbol-function 'completing-read)
+		   (lambda (&rest args) refile-target)))
+	  (call-interactively #'org-refile))
+	(buffer-string))
+      low-calorie-buffer-target)))
+  ;; Create new root nodes via `org--refile-new-path'.
+  (let* ((have-buffer "* Onions
+* Pepper
+* Ham
+")
+	 (want-buffer "* Pepper
+* Ham
+* Bread
+** Onions
+")
+	 (cursor-after "Onions")
+	 (refile-target "Bread")
+	 (org-refile-use-outline-path nil)
+	 (org-refile-targets nil)
+	 (org-refile-allow-creating-parent-nodes t))
+    (should
+     (equal
+      (org-test-with-temp-text-in-file have-buffer
+	(re-search-forward cursor-after)
+	(cl-letf (((symbol-function 'completing-read)
+		   (lambda (&rest args) refile-target)))
+	  (call-interactively #'org-refile))
+	(buffer-string))
+      want-buffer))))
+
 
 \f
 ;;; Sparse trees
-- 
2.19.1

Re: [PATCH] org: Support creating arbitrary headline paths when refiling

[Nicolas Goaziou]

Hello,

Sebastian Reuße <seb@wirrsal.net> writes:

> * org.el (org--refile-new-path): Add.
> (org-refile): Use it.
> (org-refile-new-child): Support creating new root nodes.
>
> * test-org.el (test-org/org-refile): Add test.
>
> While ‘org-refile’ currently supports creating new headlines when
> refiling, only one single headline can be created this way. For
> convenience, we now generalize this use-case to support creating
> arbitrary headline paths on the fly.

I still cannot make it work property.

With the following document:

--8<---------------cut here---------------start------------->8---
* Foo
** Bar
* Foo2
--8<---------------cut here---------------end--------------->8---

Trying to refile "Foo2" under "Foo/Bar/Baz/" results in:

--8<---------------cut here---------------start------------->8---
* Foo
** Bar
* Foo
** Bar
*** Baz
**** Foo2
--8<---------------cut here---------------end--------------->8---


Regards,

-- 
Nicolas Goaziou

[PATCH] org: Support creating arbitrary headline paths when refiling

[Sebastian Reuße]

* org.el (org--refile-new-path): Add.
(org-refile): Use it.
(org-refile-new-child): Support creating new root nodes.

* test-org.el (test-org/org-refile): Add test.

While ‘org-refile’ currently supports creating new headlines when
refiling, only one single headline can be created this way. For
convenience, we now generalize this use-case to support creating
arbitrary headline paths on the fly.
---
 lisp/org.el              | 75 ++++++++++++++++++++++++----------------
 testing/lisp/test-org.el | 67 +++++++++++++++++++++++++++++++++++
 2 files changed, 113 insertions(+), 29 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index e3866c2c0..59fed6c05 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11450,7 +11450,7 @@ (defun org-refile-get-location (&optional prompt default-buffer new-nodes)
 				  (concat " (default " (car org-refile-history) ")"))
 			     (and (assoc cbnex tbl) (setq cdef cbnex)
 				  (concat " (default " cbnex ")"))) ": "))
-	 pa answ parent-target child parent old-hist)
+	 pa answ old-hist)
     (setq old-hist org-refile-history)
     (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
 			nil 'org-refile-history (or cdef (car org-refile-history))))
@@ -11467,17 +11467,11 @@ (defun org-refile-get-location (&optional prompt default-buffer new-nodes)
 	    (when (equal (car org-refile-history) (nth 1 org-refile-history))
 	      (pop org-refile-history)))
 	  pa)
-      (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
-	  (progn
-	    (setq parent (match-string 1 answ)
-		  child (match-string 2 answ))
-	    (setq parent-target (org-refile--get-location parent tbl))
-	    (when (and parent-target
-		       (or (eq new-nodes t)
-			   (and (eq new-nodes 'confirm)
-				(y-or-n-p (format "Create new node \"%s\"? "
-						  child)))))
-	      (org-refile-new-child parent-target child)))
+      (if (or (eq new-nodes t)
+	      (and (eq new-nodes 'confirm)
+		   (y-or-n-p (format "Create new path \"%s\"? "
+				     answ))))
+	  (org--refile-new-path answ tbl)
 	(user-error "Invalid target location")))))
 
 (declare-function org-string-nw-p "org-macs" (s))
@@ -11501,29 +11495,52 @@ (defun org-refile-check-position (refile-pointer)
 	   (unless (looking-at-p re)
 	     (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
 
+(defun org--refile-new-path (path tbl)
+  "Ensure that all parent nodes leading to refile target PATH exist.
+
+Use TBL as a look-up table for existing nodes.
+
+Return the corresponding refile location."
+  (let ((target (org-refile--get-location path tbl)))
+    (or target
+	(let (parent child)
+	  (if (string-match "\\`\\(.*\\)/\\([^/]+\\)/?\\'" path)
+	      (progn
+		(setq child (match-string 2 path))
+		(setq parent (org--refile-new-path (match-string 1 path) tbl)))
+	    (setq child path))
+	  (org-refile-new-child parent child)))))
+
+
 (defun org-refile-new-child (parent-target child)
-  "Use refile target PARENT-TARGET to add new CHILD below it."
-  (unless parent-target
-    (error "Cannot find parent for new node"))
-  (let ((file (nth 1 parent-target))
-	(pos (nth 3 parent-target))
-	level)
+  "Use refile target PARENT-TARGET to add new CHILD below it.
+
+When PARENT-TARGET is ‘nil’, child will be added below the
+outline root of the current file."
+  (let (file pos)
+    (if parent-target
+	(progn
+	  (setq file (nth 1 parent-target))
+	  (setq pos (nth 3 parent-target)))
+      (setq file (buffer-file-name)))
     (with-current-buffer (or (find-buffer-visiting file)
 			     (find-file-noselect file))
       (org-with-wide-buffer
        (if pos
-	   (goto-char pos)
+	   (progn
+	     (goto-char pos)
+	     (org-insert-heading-respect-content)
+	     (org-do-demote))
+	 ;; New node is top-level
 	 (goto-char (point-max))
-	 (unless (bolp) (newline)))
-       (when (looking-at org-outline-regexp)
-	 (setq level (funcall outline-level))
-	 (org-end-of-subtree t t))
-       (org-back-over-empty-lines)
-       (insert "\n" (make-string
-		     (if pos (org-get-valid-level level 1) 1) ?*)
-	       " " child "\n")
-       (beginning-of-line 0)
-       (list (concat (car parent-target) "/" child) file "" (point))))))
+	 (unless (bolp) (newline))
+	 (org-insert-heading nil t t))
+       (insert child)
+       (beginning-of-line)
+       (list (if parent-target
+		 (format "%s/%s" (car parent-target) child)
+	       child)
+	     file "" (point))))))
 
 (defun org-olpath-completing-read (prompt collection &rest args)
   "Read an outline path like a file name."
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 3f5aa09e4..d7d69bb3c 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -5789,6 +5789,73 @@
 	    (org-refile-targets `((nil :level . 1))))
        (member (buffer-name) (mapcar #'car (org-refile-get-targets)))))))
 
+(ert-deftest test-org/org-refile ()
+  "Test `org-refile' specifications."
+  ;; Create new parent nodes via `org--refile-new-path'.
+  (let* ((low-calorie-buffer "* Cake
+** Topping
+*** Rainbow chocolates
+*** Pistachio icing
+** Filling
+*** Banana ice cream
+*** Cookie dough
+*** Crispy crunch
+* Extra Ingredients
+** Marshmallows
+")
+	 (low-calorie-buffer-target "* Cake
+** Topping
+*** Rainbow chocolates
+*** Pistachio icing
+** Filling
+*** Banana ice cream
+*** Cookie dough
+*** Crispy crunch
+** Bottom
+*** Base
+**** Marshmallows
+* Extra Ingredients
+")
+	 (cursor-after "Marshmallows")
+	 (org-refile-use-outline-path t)
+	 (org-refile-targets nil)
+	 (org-refile-allow-creating-parent-nodes t))
+    (dolist (refile-target '("Cake/Bottom/Base"
+			     "Cake/Bottom/Base/"))
+      (should
+       (equal
+	(org-test-with-temp-text-in-file low-calorie-buffer
+	  (re-search-forward cursor-after)
+	  (cl-letf (((symbol-function 'completing-read)
+		     (lambda (&rest args) refile-target)))
+	    (call-interactively #'org-refile))
+	  (buffer-string))
+	low-calorie-buffer-target))))
+  ;; Create new root nodes via `org--refile-new-path'.
+  (let* ((have-buffer "* Onions
+* Pepper
+* Ham
+")
+	 (want-buffer "* Pepper
+* Ham
+* Bread
+** Onions
+")
+	 (cursor-after "Onions")
+	 (refile-target "Bread")
+	 (org-refile-use-outline-path nil)
+	 (org-refile-targets nil)
+	 (org-refile-allow-creating-parent-nodes t))
+    (should
+     (equal
+      (org-test-with-temp-text-in-file have-buffer
+	(re-search-forward cursor-after)
+	(cl-letf (((symbol-function 'completing-read)
+		   (lambda (&rest args) refile-target)))
+	  (call-interactively #'org-refile))
+	(buffer-string))
+      want-buffer))))
+
 
 \f
 ;;; Sparse trees
-- 
2.19.1

Re: [PATCH] org: Support creating arbitrary headline paths when refiling

[Sebastian Reuße]

Hello Nicolas,

Nicolas Goaziou <mail@nicolasgoaziou.fr> writes:

> I still cannot make it work property.
>
> With the following document:
>
> --8<---------------cut 
> here---------------start------------->8---
> * Foo
> ** Bar
> * Foo2
> --8<---------------cut 
> here---------------end--------------->8---
>
> Trying to refile "Foo2" under "Foo/Bar/Baz/" results in:
>
> --8<---------------cut 
> here---------------start------------->8---
> * Foo
> ** Bar
> * Foo
> ** Bar
> *** Baz
> **** Foo2
> --8<---------------cut 
> here---------------end--------------->8---

This was due to the trailing slash in the refile target. I now 
amended the regex to normalize such input and added a test case 
with a trailing slash. Care to give it another spin?

Kind regards,

S.

-- 
Insane cobra split the wood
Trader of the lowland breed
Call a jittney, drive away
In the slipstream we will stay

Headlines with slashes when refiling

[Sebastian Reuße]

BTW this reminds me of some issues I ran into on master a while 
back. When a refile target has a headline containing a slash, 
there are some issues:

1. When an existing headline contains a slash, completing-read 
will display the target as »A\/Slash«. However, when entering the 
string manually, it must be input as »A\\/Slash«.

2. It’s not possible to refile under a newly created node when the 
new headline contains a slash, since there is no way to escape 
them.

I’ll go and look into 2 when I find some extra time. This might 
involve some awkwardness, since we don’t have regex 
look-ahead/behind in Emacs.

Kind regards,

S.

-- 
Insane cobra split the wood
Trader of the lowland breed
Call a jittney, drive away
In the slipstream we will stay

Re: [PATCH] org: Support creating arbitrary headline paths when refiling

[Nicolas Goaziou]

Sebastian Reuße <seb@wirrsal.net> writes:

> Nicolas Goaziou <mail@nicolasgoaziou.fr> writes:

[...]

>> With the following document:
>>
>> --8<---------------cut here---------------start------------->8---
>> * Foo
>> ** Bar
>> * Foo2
>> --8<---------------cut here---------------end--------------->8---
>>
>> Trying to refile "Foo2" under "Foo/Bar/Baz/" results in:
>>
>> --8<---------------cut here---------------start------------->8---
>> * Foo
>> ** Bar
>> * Foo
>> ** Bar
>> *** Baz
>> **** Foo2
>> --8<---------------cut here---------------end--------------->8---
>
> This was due to the trailing slash in the refile target. I now amended
> the regex to normalize such input and added a test case with
> a trailing slash. Care to give it another spin?

AFAICT, it still doesn't work. I get the exact same result as detailed
above.

Re: [PATCH] org: Support creating arbitrary headline paths when refiling

[Sebastian Reuße]

Nicolas Goaziou <mail@nicolasgoaziou.fr> writes:

> AFAICT, it still doesn't work. I get the exact same result as 
> detailed above.

That’s odd, I can’t reproduce your example anymore. Is your Emacs 
session still the same one as earlier today? While implementing 
the patch I had to C-0 M-x org-refile occasionally, because 
earlier runs had injected erroneous entries into the cache.

If it’s not the cache, do the tests pass for you? The first new 
test should be analogous to your example.

-- 
Insane cobra split the wood
Trader of the lowland breed
Call a jittney, drive away
In the slipstream we will stay

Re: [PATCH] org: Support creating arbitrary headline paths when refiling

[Nicolas Goaziou]

Sebastian Reuße <seb@wirrsal.net> writes:

> That’s odd, I can’t reproduce your example anymore. Is your Emacs
> session still the same one as earlier today? While implementing the
> patch I had to C-0 M-x org-refile occasionally, because earlier runs
> had injected erroneous entries into the cache.

I restarted Emacs. Cleaned the cache. Still no luck.

> If it’s not the cache, do the tests pass for you? The first new test
> should be analogous to your example.

It is not exactly analogous because I have

  (setq org-refile-use-outline-path 'file)

Note that when I set it to t instead, I get

  org-refile: Cannot refile to position inside the tree or region