* [PATCH] org: Support creating arbitrary headline paths when refiling
@ 2018-10-07 13:58 Sebastian Reuße
2018-10-10 10:49 ` Nicolas Goaziou
0 siblings, 1 reply; 13+ messages in thread
From: Sebastian Reuße @ 2018-10-07 13:58 UTC (permalink / raw)
To: emacs-orgmode; +Cc: 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
^ permalink raw reply related [flat|nested] 13+ messages in thread
* Re: [PATCH] org: Support creating arbitrary headline paths when refiling
2018-10-07 13:58 [PATCH] org: Support creating arbitrary headline paths when refiling Sebastian Reuße
@ 2018-10-10 10:49 ` Nicolas Goaziou
2018-10-10 11:24 ` Sebastian Reuße
2018-10-10 11:27 ` Sebastian Reuße
0 siblings, 2 replies; 13+ messages in thread
From: Nicolas Goaziou @ 2018-10-10 10:49 UTC (permalink / raw)
To: Sebastian Reuße; +Cc: emacs-orgmode
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
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH] org: Support creating arbitrary headline paths when refiling
2018-10-10 10:49 ` Nicolas Goaziou
@ 2018-10-10 11:24 ` Sebastian Reuße
2018-10-11 6:35 ` Sebastian Reuße
2018-10-10 11:27 ` Sebastian Reuße
1 sibling, 1 reply; 13+ messages in thread
From: Sebastian Reuße @ 2018-10-10 11:24 UTC (permalink / raw)
To: emacs-orgmode; +Cc: 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
^ permalink raw reply related [flat|nested] 13+ messages in thread
* Re: [PATCH] org: Support creating arbitrary headline paths when refiling
2018-10-10 10:49 ` Nicolas Goaziou
2018-10-10 11:24 ` Sebastian Reuße
@ 2018-10-10 11:27 ` Sebastian Reuße
1 sibling, 0 replies; 13+ messages in thread
From: Sebastian Reuße @ 2018-10-10 11:27 UTC (permalink / raw)
To: Nicolas Goaziou; +Cc: emacs-orgmode
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
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [PATCH] org: Support creating arbitrary headline paths when refiling
2018-10-10 11:24 ` Sebastian Reuße
@ 2018-10-11 6:35 ` Sebastian Reuße
2018-10-11 11:30 ` Sebastian Reuße
0 siblings, 1 reply; 13+ messages in thread
From: Sebastian Reuße @ 2018-10-11 6:35 UTC (permalink / raw)
To: emacs-orgmode; +Cc: Nicolas Goaziou
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
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH] org: Support creating arbitrary headline paths when refiling
2018-10-11 6:35 ` Sebastian Reuße
@ 2018-10-11 11:30 ` Sebastian Reuße
2018-10-14 7:38 ` Nicolas Goaziou
0 siblings, 1 reply; 13+ messages in thread
From: Sebastian Reuße @ 2018-10-11 11:30 UTC (permalink / raw)
To: emacs-orgmode; +Cc: Sebastian Reuße, mail
* 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
^ permalink raw reply related [flat|nested] 13+ messages in thread
* Re: [PATCH] org: Support creating arbitrary headline paths when refiling
2018-10-11 11:30 ` Sebastian Reuße
@ 2018-10-14 7:38 ` Nicolas Goaziou
2018-10-14 8:04 ` Sebastian Reuße
2018-10-14 8:05 ` [PATCH] org: Support creating arbitrary headline paths " Sebastian Reuße
0 siblings, 2 replies; 13+ messages in thread
From: Nicolas Goaziou @ 2018-10-14 7:38 UTC (permalink / raw)
To: Sebastian Reuße; +Cc: emacs-orgmode
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
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH] org: Support creating arbitrary headline paths when refiling
2018-10-14 7:38 ` Nicolas Goaziou
@ 2018-10-14 8:04 ` Sebastian Reuße
2018-10-14 8:58 ` Headlines with slashes " Sebastian Reuße
2018-10-14 8:05 ` [PATCH] org: Support creating arbitrary headline paths " Sebastian Reuße
1 sibling, 1 reply; 13+ messages in thread
From: Sebastian Reuße @ 2018-10-14 8:04 UTC (permalink / raw)
To: emacs-orgmode; +Cc: Sebastian Reuße, mail
* 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
^ permalink raw reply related [flat|nested] 13+ messages in thread
* Re: [PATCH] org: Support creating arbitrary headline paths when refiling
2018-10-14 7:38 ` Nicolas Goaziou
2018-10-14 8:04 ` Sebastian Reuße
@ 2018-10-14 8:05 ` Sebastian Reuße
2018-10-14 14:14 ` Nicolas Goaziou
1 sibling, 1 reply; 13+ messages in thread
From: Sebastian Reuße @ 2018-10-14 8:05 UTC (permalink / raw)
To: Nicolas Goaziou; +Cc: emacs-orgmode
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
^ permalink raw reply [flat|nested] 13+ messages in thread
* Headlines with slashes when refiling
2018-10-14 8:04 ` Sebastian Reuße
@ 2018-10-14 8:58 ` Sebastian Reuße
0 siblings, 0 replies; 13+ messages in thread
From: Sebastian Reuße @ 2018-10-14 8:58 UTC (permalink / raw)
To: emacs-orgmode; +Cc: mail
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
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [PATCH] org: Support creating arbitrary headline paths when refiling
2018-10-14 8:05 ` [PATCH] org: Support creating arbitrary headline paths " Sebastian Reuße
@ 2018-10-14 14:14 ` Nicolas Goaziou
2018-10-14 14:30 ` Sebastian Reuße
0 siblings, 1 reply; 13+ messages in thread
From: Nicolas Goaziou @ 2018-10-14 14:14 UTC (permalink / raw)
To: Sebastian Reuße; +Cc: emacs-orgmode
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.
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [PATCH] org: Support creating arbitrary headline paths when refiling
2018-10-14 14:14 ` Nicolas Goaziou
@ 2018-10-14 14:30 ` Sebastian Reuße
2018-10-14 20:24 ` Nicolas Goaziou
0 siblings, 1 reply; 13+ messages in thread
From: Sebastian Reuße @ 2018-10-14 14:30 UTC (permalink / raw)
To: Nicolas Goaziou; +Cc: emacs-orgmode
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
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [PATCH] org: Support creating arbitrary headline paths when refiling
2018-10-14 14:30 ` Sebastian Reuße
@ 2018-10-14 20:24 ` Nicolas Goaziou
0 siblings, 0 replies; 13+ messages in thread
From: Nicolas Goaziou @ 2018-10-14 20:24 UTC (permalink / raw)
To: Sebastian Reuße; +Cc: emacs-orgmode
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
^ permalink raw reply [flat|nested] 13+ messages in thread
end of thread, other threads:[~2018-10-14 20:24 UTC | newest]
Thread overview: 13+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-10-07 13:58 [PATCH] org: Support creating arbitrary headline paths when refiling Sebastian Reuße
2018-10-10 10:49 ` Nicolas Goaziou
2018-10-10 11:24 ` Sebastian Reuße
2018-10-11 6:35 ` Sebastian Reuße
2018-10-11 11:30 ` Sebastian Reuße
2018-10-14 7:38 ` Nicolas Goaziou
2018-10-14 8:04 ` Sebastian Reuße
2018-10-14 8:58 ` Headlines with slashes " Sebastian Reuße
2018-10-14 8:05 ` [PATCH] org: Support creating arbitrary headline paths " Sebastian Reuße
2018-10-14 14:14 ` Nicolas Goaziou
2018-10-14 14:30 ` Sebastian Reuße
2018-10-14 20:24 ` Nicolas Goaziou
2018-10-10 11:27 ` Sebastian Reuße
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).