Refiling: Allow to create new nodes.

When refiling, you can now create new parent nodes on the fly.  To do
this, set the variable `org-refile-allow-creating-parent-nodes' to
`confirm'.  Then, at a refiling prompt, proceed with completion until
you have an existing heading, and then add "/new heading", i.e. a
slash followed by the new heading.  That heading will be created as a
child of the existing heading, and the entry to be refiled will end up
under that new heading.

4 files changed, 75 insertions, 6 deletions

diff --git a/doc/ChangeLog b/doc/ChangeLog
index 7a8548c..216d649 100644
--- a/doc/ChangeLog
+++ b/doc/ChangeLog
@@ -1,6 +1,8 @@
 2009-04-14  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org.texi (CSS support): Document new class.
+	(Refiling notes): Document the possibility to create new nodes
+	during refiling.
 
 2009-03-31  Carsten Dominik  <carsten.dominik@gmail.com>
 
diff --git a/doc/org.texi b/doc/org.texi
index c53fb67..b279e50 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -5647,6 +5647,7 @@ special command:
 @vindex org-refile-targets
 @vindex org-refile-use-outline-path
 @vindex org-outline-path-complete-in-steps
+@vindex org-refile-allow-creating-parent-nodes
 Refile the entry or region at point.  This command offers possible locations
 for refiling the entry and lets you select one with completion.  The item (or
 all items in the region) is filed below the target heading as a subitem.
@@ -5657,7 +5658,9 @@ targets, but you can have more complex definitions across a number of files.
 See the variable @code{org-refile-targets} for details.  If you would like to
 select a location via a file-path-like completion along the outline path, see
 the variables @code{org-refile-use-outline-path} and
-@code{org-outline-path-complete-in-steps}.
+@code{org-outline-path-complete-in-steps}.  If you would like to be able to
+create new nodes as new parents for for refiling on the fly, check the
+variable @code{org-refile-allow-creating-parent-nodes}.
 @kindex C-u C-c C-w
 @item C-u C-c C-w
 Use the refile interface to jump to a heading.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 06a9e34..425865e 100755
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,12 @@
 2009-04-14  Carsten Dominik  <carsten.dominik@gmail.com>
 
+	* org.el (org-refile-allow-creating-parent-nodes): New option.
+	(org-refile-get-location): New argument NEW-NODES.
+	(org-refile): Call `org-refile-get-location' with the new
+	argument.
+	(org-refile-get-location): Arrange for adding a new child.
+	(org-refile-new-child): New function.
+
 	* org-html.el (org-html-handle-time-stamps): Wrap time stamps into
 	an additional span element.
 
diff --git a/lisp/org.el b/lisp/org.el
index c331427..af2c97c 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -1543,6 +1543,23 @@ fast, while still showing the whole path to the entry."
   :group 'org-refile
   :type 'boolean)
 
+(defcustom org-refile-allow-creating-parent-nodes nil
+  "Non-nil means, allow to create new nodes as refile targets.
+New nodes are then created by adding \"/new node name\" to the completion
+of an existing node.  When the value of this variable is `confirm',
+new node creation must be confirmed by the user (recommended)
+When nil, the completion must match an existing entry.
+
+Note that, if the new heading is not seen by the criteria
+listed in `org-refile-targets', multiple instances of the same
+heading would be created by trying again to file under the new
+heading."
+  :group 'org-refile
+  :type '(choice
+	  (const :tag "Never" nil)
+	  (const :tag "Always" t)
+	  (const :tag "Prompt for confirmation" confirm)))
+
 (defgroup org-todo nil
   "Options concerning TODO items in Org-mode."
   :tag "Org TODO"
@@ -8261,7 +8278,8 @@ See also `org-refile-use-outline-path' and `org-completion-use-ido'"
     (if (equal goto '(16))
 	(org-refile-goto-last-stored)
       (when (setq it (org-refile-get-location
-		      (if goto "Goto: " "Refile to: ") default-buffer))
+		      (if goto "Goto: " "Refile to: ") default-buffer
+		      org-refile-allow-creating-parent-nodes))
 	(setq file (nth 1 it)
 	      re (nth 2 it)
 	      pos (nth 3 it))
@@ -8326,7 +8344,7 @@ See also `org-refile-use-outline-path' and `org-completion-use-ido'"
   (bookmark-jump "org-refile-last-stored")
   (message "This is the location of the last refile"))
 
-(defun org-refile-get-location (&optional prompt default-buffer)
+(defun org-refile-get-location (&optional prompt default-buffer new-nodes)
   "Prompt the user for a refile location, using PROMPT."
   (let ((org-refile-targets org-refile-targets)
 	(org-refile-use-outline-path org-refile-use-outline-path))
@@ -8352,9 +8370,48 @@ See also `org-refile-use-outline-path' and `org-completion-use-ido'"
 			   (cdr x))
 		   (cons (concat (car x) extra) (cdr x))))
 	       org-refile-target-table))
-	 (completion-ignore-case t))
-    (assoc (funcall cfunc prompt tbl nil t nil 'org-refile-history)
-	   tbl)))
+	 (completion-ignore-case t)
+	 pa answ parent-target child parent)
+    (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
+			nil 'org-refile-history))
+    (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl)))
+    (if pa
+	pa
+      (when (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
+	(setq parent (match-string 1 answ)
+	      child (match-string 2 answ))
+	(setq parent-target (or (assoc parent tbl) (assoc (concat 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))))))
+
+(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)
+    (with-current-buffer (or (find-buffer-visiting file)
+			     (find-file-noselect file))
+      (save-excursion
+	(save-restriction
+	  (widen)
+	  (if pos
+	      (goto-char pos)
+	    (goto-char (point-max))
+	    (if (not (bolp)) (newline)))
+	  (when (looking-at 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)))))))
 
 (defun org-olpath-completing-read (prompt collection &rest args)
   "Read an outline path like a file name."