org.el: exclude current heading from the refile table.
authorBastien Guerry <bzg@altern.org>
Mon, 18 Jul 2011 20:57:53 +0000 (22:57 +0200)
committerBastien Guerry <bzg@altern.org>
Mon, 18 Jul 2011 20:57:53 +0000 (22:57 +0200)
* org.el (org-refile-get-location): exclude current heading
from the refile table.

Thanks to Jason Dunsmore for this idea.

lisp/org.el

index 8529b2b..4e9f206 100644 (file)
@@ -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."