From mboxrd@z Thu Jan 1 00:00:00 1970 From: =?UTF-8?q?Sebastian=20Reu=C3=9Fe?= Subject: [PATCH] org: Support creating arbitrary headline paths when refiling Date: Wed, 10 Oct 2018 13:24:50 +0200 Message-ID: <20181010112450.17850-1-seb@wirrsal.net> References: <87ftxecc03.fsf@nicolasgoaziou.fr> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:57727) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gACc3-0006jq-IV for emacs-orgmode@gnu.org; Wed, 10 Oct 2018 07:25:17 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gACbv-0007si-Ek for emacs-orgmode@gnu.org; Wed, 10 Oct 2018 07:25:09 -0400 Received: from wirrsal.net ([188.68.36.149]:44122 helo=mail.wirrsal.net) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1gACbv-0007ha-0y for emacs-orgmode@gnu.org; Wed, 10 Oct 2018 07:25:03 -0400 In-Reply-To: <87ftxecc03.fsf@nicolasgoaziou.fr> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: emacs-orgmode@gnu.org Cc: =?UTF-8?q?Sebastian=20Reu=C3=9Fe?= * 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 =E2=80=98org-refile=E2=80=99 currently supports creating new headli= nes 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 promp= t 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"))))) =20 (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")))))))) =20 +(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))))))= ) =20 +(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)))) + =20 =0C ;;; Sparse trees --=20 2.19.1