Keep headlines named like current one in refile targets

* lisp/org.el (org-refile-get-targets): Change signature.
(org-refile-get-location): Change signature.  Also apply change above.
(org-goto):
(org-refile): Apply change above.

Reported-by: Samuel Wales <samologist@gmail.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/106051>
This commit is contained in:
Nicolas Goaziou 2016-04-05 23:45:37 +02:00
parent 0e0a72443a
commit 64ca6f2c24
1 changed files with 26 additions and 39 deletions

View File

@ -7365,7 +7365,7 @@ With a prefix argument, use the alternative interface: e.g., if
(selected-point (selected-point
(if (eq interface 'outline) (if (eq interface 'outline)
(car (org-get-location (current-buffer) org-goto-help)) (car (org-get-location (current-buffer) org-goto-help))
(let ((pa (org-refile-get-location "Goto" nil nil t))) (let ((pa (org-refile-get-location "Goto")))
(org-refile-check-position pa) (org-refile-check-position pa)
(nth 3 pa))))) (nth 3 pa)))))
(if selected-point (if selected-point
@ -11498,7 +11498,7 @@ buffer position at the beginning of an entry and PATH is a list
of strings describing the outline path for that entry, in reverse of strings describing the outline path for that entry, in reverse
order.") order.")
(defun org-refile-get-targets (&optional default-buffer excluded-entries) (defun org-refile-get-targets (&optional default-buffer)
"Produce a table with refile targets." "Produce a table with refile targets."
(let ((case-fold-search nil) (let ((case-fold-search nil)
;; otherwise org confuses "TODO" as a kw and "Todo" as a word ;; otherwise org confuses "TODO" as a kw and "Todo" as a word
@ -11559,8 +11559,7 @@ order.")
org-refile-target-verify-function org-refile-target-verify-function
(not (not
(funcall org-refile-target-verify-function))) (funcall org-refile-target-verify-function)))
(not heading) (not heading))
(member heading excluded-entries))
(let ((re (format org-complex-heading-regexp-format (let ((re (format org-complex-heading-regexp-format
(regexp-quote heading))) (regexp-quote heading)))
(target (target
@ -11797,25 +11796,25 @@ prefix argument (`C-u C-u C-u C-c C-w')."
"" ""
(marker-position org-clock-hd-marker))) (marker-position org-clock-hd-marker)))
(setq arg nil))) (setq arg nil)))
(setq it (or rfloc (setq it
(let (heading-text) (or rfloc
(save-excursion (let (heading-text)
(unless (and arg (listp arg)) (save-excursion
(org-back-to-heading t) (unless (and arg (listp arg))
(setq heading-text (org-back-to-heading t)
(replace-regexp-in-string (setq heading-text
org-bracket-link-regexp (replace-regexp-in-string
"\\3" org-bracket-link-regexp
(nth 4 (org-heading-components))))) "\\3"
(org-refile-get-location (nth 4 (org-heading-components)))))
(cond ((and arg (listp arg)) "Goto") (org-refile-get-location
(regionp (concat actionmsg " region to")) (cond ((and arg (listp arg)) "Goto")
(t (concat actionmsg " subtree \"" (regionp (concat actionmsg " region to"))
heading-text "\" to"))) (t (concat actionmsg " subtree \""
default-buffer heading-text "\" to")))
(and (not (equal '(4) arg)) default-buffer
org-refile-allow-creating-parent-nodes) (and (not (equal '(4) arg))
arg)))))) org-refile-allow-creating-parent-nodes)))))))
(setq file (nth 1 it) (setq file (nth 1 it)
pos (nth 3 it)) pos (nth 3 it))
(when (and (not arg) (when (and (not arg)
@ -11915,26 +11914,14 @@ Also check `org-refile-target-table'."
(list (replace-regexp-in-string "/$" "" refloc) (list (replace-regexp-in-string "/$" "" refloc)
(replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc)))))) (replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc))))))
(defun org-refile-get-location (&optional prompt default-buffer new-nodes (defun org-refile-get-location (&optional prompt default-buffer new-nodes)
no-exclude)
"Prompt the user for a refile location, using PROMPT. "Prompt the user for a refile location, using PROMPT.
PROMPT should not be suffixed with a colon and a space, because PROMPT should not be suffixed with a colon and a space, because
this function appends the default value from this function appends the default value from
`org-refile-history' automatically, if that is not empty. `org-refile-history' automatically, if that is not empty."
When NO-EXCLUDE is set, do not exclude headlines in the current subtree,
this is used for the GOTO interface."
(let ((org-refile-targets org-refile-targets) (let ((org-refile-targets org-refile-targets)
(org-refile-use-outline-path org-refile-use-outline-path) (org-refile-use-outline-path org-refile-use-outline-path))
excluded-entries) (setq org-refile-target-table (org-refile-get-targets default-buffer)))
(when (and (derived-mode-p 'org-mode)
(not org-refile-use-cache)
(not no-exclude))
(org-map-tree
(lambda()
(setq excluded-entries
(append excluded-entries (list (org-get-heading t t)))))))
(setq org-refile-target-table
(org-refile-get-targets default-buffer excluded-entries)))
(unless org-refile-target-table (unless org-refile-target-table
(user-error "No refile targets")) (user-error "No refile targets"))
(let* ((cbuf (current-buffer)) (let* ((cbuf (current-buffer))