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: Sun, 7 Oct 2018 15:58:31 +0200 Message-ID: <20181007135831.26003-1-seb@wirrsal.net> 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]:46720) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1g99bD-0004Ln-VN for emacs-orgmode@gnu.org; Sun, 07 Oct 2018 10:00:00 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1g99b8-0006rl-Vo for emacs-orgmode@gnu.org; Sun, 07 Oct 2018 09:59:59 -0400 Received: from wirrsal.net ([188.68.36.149]:59668 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 1g99b8-0006cA-Il for emacs-orgmode@gnu.org; Sun, 07 Oct 2018 09:59:54 -0400 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 | 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 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)) @@ -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")))))))) =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 @@ -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))))))= ) =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.0