Refile: New function to verify a target.

The variable `org-refile-target-verify-function' can be set to a
function that will be called to verify a refile target.  The function
must return t if the target is valid.

4 files changed, 48 insertions, 23 deletions

diff --git a/doc/org.texi b/doc/org.texi
index 3c48f4d..b858c47 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -2826,11 +2826,11 @@ buffer (see below).  What kind of link will be created depends on the current
 buffer: 
 
 @b{Org-mode buffers}@*
-@vindex org-link-to-org-use-id
 For Org files, if there is a @samp{<<target>>} at the cursor, the link points
 to the target.  Otherwise it points to the current headline, which will also
 be the description.
 
+@vindex org-link-to-org-use-id
 If the headline has a @code{CUSTOM_ID} property, a link to this custom ID
 will be stored.  In addition or alternatively (depending on the value of
 @code{org-link-to-org-use-id}), a globally unique @code{ID} property will be
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b46afe1..c6f4774 100755
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,10 +1,16 @@
 2009-04-17  Carsten Dominik  <carsten.dominik@gmail.com>
 
+	* org-id.el (org-id-get-with-outline-path-completion): Turn off
+	org-refile-target-verify-function for the duration of the command.
+
 	* org.el (org-link-to-org-use-id): New possible value
 	`create-if-interactive-and-no-custom-id'.
 	(org-store-link): Use custom IDs.
 	(org-link-search): Find custom ID properties from #link.
 	(org-default-properties): Add CUSTOM_ID for property completion.
+	(org-refile-target-verify-function): New option.
+	(org-goto): Turn off org-refile-target-verify-function
+	for the duration of the command.
 
 2009-04-16  Carsten Dominik  <carsten.dominik@gmail.com>
 
diff --git a/lisp/org-id.el b/lisp/org-id.el
index 713c49d..0d61e3a 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -228,6 +228,7 @@ It returns the ID of the entry.  If necessary, the ID is created."
   (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10)))))
 	 (org-refile-use-outline-path
 	  (if (caar org-refile-targets) 'file t))
+	 (org-refile-target-verify-function nil)
 	 (spos (org-refile-get-location "Entry: "))
 	 (pom (and spos (move-marker (make-marker) (nth 3 spos)
 				     (get-file-buffer (nth 1 spos))))))
diff --git a/lisp/org.el b/lisp/org.el
index cd3aa60..c4bb620 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -1501,6 +1501,9 @@ This is list of cons cells.  Each cell contains:
     Note that, when `org-odd-levels-only' is set, level corresponds to
     order in hierarchy, not to the number of stars.
 
+You can set the variable `org-refile-target-verify-function' to a function
+to verify each headline found by the simple critery above.
+
 When this variable is nil, all top-level headlines in the current buffer
 are used, equivalent to the value `((nil . (:level . 1))'."
   :group 'org-refile
@@ -1517,6 +1520,14 @@ are used, equivalent to the value `((nil . (:level . 1))'."
 	    (cons :tag "Level number" (const :value :level) (integer))
 	    (cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
 
+(defcustom org-refile-target-verify-function nil
+  "Function to verify if the headline at point should be a refile target.
+The function will be called without arguments, with point at the beginning
+of the headline.  It should return t if the headline is a valid target
+for refiling."
+  :group 'org-refile
+  :type 'function)
+
 (defcustom org-refile-use-outline-path nil
   "Non-nil means, provide refile targets as paths.
 So a level 3 headline will be available as level1/level2/level3.
@@ -5020,6 +5031,7 @@ the headline hierarchy above."
   (interactive "P")
   (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
 	 (org-refile-use-outline-path t)
+	 (org-refile-target-verify-function nil)
 	 (interface
 	  (if (not alternative-interface)
 	      org-goto-interface
@@ -8211,28 +8223,34 @@ on the system \"/user@host:\"."
 		(goto-char (point-min))
 		(while (re-search-forward descre nil t)
 		  (goto-char (point-at-bol))
-		  (when (looking-at org-complex-heading-regexp)
-		    (setq level (org-reduced-level (- (match-end 1) (match-beginning 1)))
-			  txt (org-link-display-format (match-string 4))
-			  re (concat "^" (regexp-quote
-					  (buffer-substring (match-beginning 1)
-							    (match-end 4)))))
-		    (if (match-end 5) (setq re (concat re "[ \t]+"
-						       (regexp-quote
-							(match-string 5)))))
-		    (setq re (concat re "[ \t]*$"))
-		    (when org-refile-use-outline-path
-		      (setq txt (mapconcat 'org-protect-slash
-					   (append
-					    (if (eq org-refile-use-outline-path 'file)
-						(list (file-name-nondirectory
-						       (buffer-file-name (buffer-base-buffer))))
-					      (if (eq org-refile-use-outline-path 'full-file-path)
-						  (list (buffer-file-name (buffer-base-buffer)))))
-					    (org-get-outline-path fast-path-p level txt)
-					    (list txt))
-					   "/")))
-		    (push (list txt f re (point)) targets))
+		  (catch 'next
+		    (when org-refile-target-verify-function
+		      (save-excursion
+			(save-match-data
+			  (or (funcall org-refile-target-verify-function)
+			      (throw 'next t)))))
+		    (when (looking-at org-complex-heading-regexp)
+		      (setq level (org-reduced-level (- (match-end 1) (match-beginning 1)))
+			    txt (org-link-display-format (match-string 4))
+			    re (concat "^" (regexp-quote
+					    (buffer-substring (match-beginning 1)
+							      (match-end 4)))))
+		      (if (match-end 5) (setq re (concat re "[ \t]+"
+							 (regexp-quote
+							  (match-string 5)))))
+		      (setq re (concat re "[ \t]*$"))
+		      (when org-refile-use-outline-path
+			(setq txt (mapconcat 'org-protect-slash
+					     (append
+					      (if (eq org-refile-use-outline-path 'file)
+						  (list (file-name-nondirectory
+							 (buffer-file-name (buffer-base-buffer))))
+						(if (eq org-refile-use-outline-path 'full-file-path)
+						    (list (buffer-file-name (buffer-base-buffer)))))
+					      (org-get-outline-path fast-path-p level txt)
+					      (list txt))
+					     "/")))
+		      (push (list txt f re (point)) targets)))
 		  (goto-char (point-at-eol))))))))
     (message "Getting targets...done")
     (nreverse targets))))