mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-12-02 08:22:16 +00:00
Code

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

Browse Source 
This reverts commit 651a537e49.
This commit is contained in:
Bastien Guerry 2011-07-21 12:28:57 +02:00
parent 26b084d3b5
commit 74a4f97108
1 changed files with 57 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
lisp/org.el
View File

@ -10499,67 +10499,64 @@ 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))
(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
(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)
(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)
(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"))))))
(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."