Browse Source

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.
Carsten Dominik 16 years ago
parent
commit
4b4328e29b
4 changed files with 48 additions and 23 deletions
  1. 1 1
      doc/org.texi
  2. 6 0
      lisp/ChangeLog
  3. 1 0
      lisp/org-id.el
  4. 40 22
      lisp/org.el

+ 1 - 1
doc/org.texi

@@ -2826,11 +2826,11 @@ buffer (see below).  What kind of link will be created depends on the current
 buffer: 
 buffer: 
 
 
 @b{Org-mode buffers}@*
 @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
 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
 to the target.  Otherwise it points to the current headline, which will also
 be the description.
 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
 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
 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
 @code{org-link-to-org-use-id}), a globally unique @code{ID} property will be

+ 6 - 0
lisp/ChangeLog

@@ -1,10 +1,16 @@
 2009-04-17  Carsten Dominik  <carsten.dominik@gmail.com>
 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
 	* org.el (org-link-to-org-use-id): New possible value
 	`create-if-interactive-and-no-custom-id'.
 	`create-if-interactive-and-no-custom-id'.
 	(org-store-link): Use custom IDs.
 	(org-store-link): Use custom IDs.
 	(org-link-search): Find custom ID properties from #link.
 	(org-link-search): Find custom ID properties from #link.
 	(org-default-properties): Add CUSTOM_ID for property completion.
 	(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>
 2009-04-16  Carsten Dominik  <carsten.dominik@gmail.com>
 
 

+ 1 - 0
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)))))
   (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10)))))
 	 (org-refile-use-outline-path
 	 (org-refile-use-outline-path
 	  (if (caar org-refile-targets) 'file t))
 	  (if (caar org-refile-targets) 'file t))
+	 (org-refile-target-verify-function nil)
 	 (spos (org-refile-get-location "Entry: "))
 	 (spos (org-refile-get-location "Entry: "))
 	 (pom (and spos (move-marker (make-marker) (nth 3 spos)
 	 (pom (and spos (move-marker (make-marker) (nth 3 spos)
 				     (get-file-buffer (nth 1 spos))))))
 				     (get-file-buffer (nth 1 spos))))))

+ 40 - 22
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
     Note that, when `org-odd-levels-only' is set, level corresponds to
     order in hierarchy, not to the number of stars.
     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
 When this variable is nil, all top-level headlines in the current buffer
 are used, equivalent to the value `((nil . (:level . 1))'."
 are used, equivalent to the value `((nil . (:level . 1))'."
   :group 'org-refile
   :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 "Level number" (const :value :level) (integer))
 	    (cons :tag "Max Level number" (const :value :maxlevel) (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
 (defcustom org-refile-use-outline-path nil
   "Non-nil means, provide refile targets as paths.
   "Non-nil means, provide refile targets as paths.
 So a level 3 headline will be available as level1/level2/level3.
 So a level 3 headline will be available as level1/level2/level3.
@@ -5020,6 +5031,7 @@ the headline hierarchy above."
   (interactive "P")
   (interactive "P")
   (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
   (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
 	 (org-refile-use-outline-path t)
 	 (org-refile-use-outline-path t)
+	 (org-refile-target-verify-function nil)
 	 (interface
 	 (interface
 	  (if (not alternative-interface)
 	  (if (not alternative-interface)
 	      org-goto-interface
 	      org-goto-interface
@@ -8211,28 +8223,34 @@ on the system \"/user@host:\"."
 		(goto-char (point-min))
 		(goto-char (point-min))
 		(while (re-search-forward descre nil t)
 		(while (re-search-forward descre nil t)
 		  (goto-char (point-at-bol))
 		  (goto-char (point-at-bol))
-		  (when (looking-at org-complex-heading-regexp)
+		  (catch 'next
-		    (setq level (org-reduced-level (- (match-end 1) (match-beginning 1)))
+		    (when org-refile-target-verify-function
-			  txt (org-link-display-format (match-string 4))
+		      (save-excursion
-			  re (concat "^" (regexp-quote
+			(save-match-data
-					  (buffer-substring (match-beginning 1)
+			  (or (funcall org-refile-target-verify-function)
-							    (match-end 4)))))
+			      (throw 'next t)))))
-		    (if (match-end 5) (setq re (concat re "[ \t]+"
+		    (when (looking-at org-complex-heading-regexp)
-						       (regexp-quote
+		      (setq level (org-reduced-level (- (match-end 1) (match-beginning 1)))
-							(match-string 5)))))
+			    txt (org-link-display-format (match-string 4))
-		    (setq re (concat re "[ \t]*$"))
+			    re (concat "^" (regexp-quote
-		    (when org-refile-use-outline-path
+					    (buffer-substring (match-beginning 1)
-		      (setq txt (mapconcat 'org-protect-slash
+							      (match-end 4)))))
-					   (append
+		      (if (match-end 5) (setq re (concat re "[ \t]+"
-					    (if (eq org-refile-use-outline-path 'file)
+							 (regexp-quote
-						(list (file-name-nondirectory
+							  (match-string 5)))))
-						       (buffer-file-name (buffer-base-buffer))))
+		      (setq re (concat re "[ \t]*$"))
-					      (if (eq org-refile-use-outline-path 'full-file-path)
+		      (when org-refile-use-outline-path
-						  (list (buffer-file-name (buffer-base-buffer)))))
+			(setq txt (mapconcat 'org-protect-slash
-					    (org-get-outline-path fast-path-p level txt)
+					     (append
-					    (list txt))
+					      (if (eq org-refile-use-outline-path 'file)
-					   "/")))
+						  (list (file-name-nondirectory
-		    (push (list txt f re (point)) targets))
+							 (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))))))))
 		  (goto-char (point-at-eol))))))))
     (message "Getting targets...done")
     (message "Getting targets...done")
     (nreverse targets))))
     (nreverse targets))))