Browse Source

org.el: exclude current heading from the refile table.

* org.el (org-refile-get-location): exclude current heading
from the refile table.

Thanks to Jason Dunsmore for this idea.
Bastien Guerry 6 years ago
parent
commit
651a537e49
1 changed files with 60 additions and 57 deletions
  1. 60 57
      lisp/org.el

+ 60 - 57
lisp/org.el

@@ -10497,64 +10497,67 @@ this function appends the default value from
 `org-refile-history' automatically, if that is not empty."
   (let ((org-refile-targets org-refile-targets)
 	(org-refile-use-outline-path org-refile-use-outline-path))
-    (setq org-refile-target-table (org-refile-get-targets default-buffer)))
-  (unless org-refile-target-table
-    (error "No refile targets"))
-  (let* ((prompt (concat prompt
-			 (and (car org-refile-history)
-			      (concat " (default " (car org-refile-history) ")"))
-			 ": "))
-	 (cbuf (current-buffer))
-	 (partial-completion-mode nil)
-	 (cfn (buffer-file-name (buffer-base-buffer cbuf)))
-	 (cfunc (if (and org-refile-use-outline-path
-			 org-outline-path-complete-in-steps)
-		    'org-olpath-completing-read
-		  'org-icompleting-read))
-	 (extra (if org-refile-use-outline-path "/" ""))
-	 (filename (and cfn (expand-file-name cfn)))
-	 (tbl (mapcar
-	       (lambda (x)
-		 (if (and (not (member org-refile-use-outline-path
-				       '(file full-file-path)))
-			  (not (equal filename (nth 1 x))))
-		     (cons (concat (car x) extra " ("
-				   (file-name-nondirectory (nth 1 x)) ")")
-			   (cdr x))
-		   (cons (concat (car x) extra) (cdr x))))
-	       org-refile-target-table))
-	 (completion-ignore-case t)
-	 pa answ parent-target child parent old-hist)
-    (setq old-hist org-refile-history)
-    (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
-			nil 'org-refile-history (car org-refile-history)))
-    (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl)))
-    (org-refile-check-position pa)
-    (if pa
-	(progn
-	  (when (or (not org-refile-history)
-		    (not (eq old-hist org-refile-history))
-		    (not (equal (car pa) (car org-refile-history))))
-	    (setq org-refile-history
-		  (cons (car pa) (if (assoc (car org-refile-history) tbl)
-				     org-refile-history
-				   (cdr org-refile-history))))
-	    (if (equal (car org-refile-history) (nth 1 org-refile-history))
-		(pop org-refile-history)))
-	  pa)
-      (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
+    (setq org-refile-target-table (org-refile-get-targets default-buffer))
+    (setq org-refile-target-table
+	  (delq (assoc (org-get-heading) org-refile-target-table)
+		org-refile-target-table))
+    (unless org-refile-target-table
+      (error "No refile targets"))
+    (let* ((prompt (concat prompt
+			   (and (car org-refile-history)
+				(concat " (default " (car org-refile-history) ")"))
+			   ": "))
+	   (cbuf (current-buffer))
+	   (partial-completion-mode nil)
+	   (cfn (buffer-file-name (buffer-base-buffer cbuf)))
+	   (cfunc (if (and org-refile-use-outline-path
+			   org-outline-path-complete-in-steps)
+		      'org-olpath-completing-read
+		    'org-icompleting-read))
+	   (extra (if org-refile-use-outline-path "/" ""))
+	   (filename (and cfn (expand-file-name cfn)))
+	   (tbl (mapcar
+		 (lambda (x)
+		   (if (and (not (member org-refile-use-outline-path
+					 '(file full-file-path)))
+			    (not (equal filename (nth 1 x))))
+		       (cons (concat (car x) extra " ("
+				     (file-name-nondirectory (nth 1 x)) ")")
+			     (cdr x))
+		     (cons (concat (car x) extra) (cdr x))))
+		 org-refile-target-table))
+	   (completion-ignore-case t)
+	   pa answ parent-target child parent old-hist)
+      (setq old-hist org-refile-history)
+      (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
+			  nil 'org-refile-history (car org-refile-history)))
+      (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl)))
+      (org-refile-check-position pa)
+      (if pa
 	  (progn
-	    (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)))
-	(error "Invalid target location")))))
+	    (when (or (not org-refile-history)
+		      (not (eq old-hist org-refile-history))
+		      (not (equal (car pa) (car org-refile-history))))
+	      (setq org-refile-history
+		    (cons (car pa) (if (assoc (car org-refile-history) tbl)
+				       org-refile-history
+				     (cdr org-refile-history))))
+	      (if (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 (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)))
+	  (error "Invalid target location"))))))
 
 (defun org-refile-check-position (refile-pointer)
   "Check if the refile pointer matches the readline to which it points."