summaryrefslogtreecommitdiff
path: root/elpa/org-9.5.2/org-refile.el
diff options
context:
space:
mode:
authormattkae <mattkae@protonmail.com>2022-05-11 09:23:58 -0400
committermattkae <mattkae@protonmail.com>2022-05-11 09:23:58 -0400
commit3f4a0d5370ae6c34afe180df96add3b8522f4af1 (patch)
treeae901409e02bde8ee278475f8cf6818f8f680a60 /elpa/org-9.5.2/org-refile.el
initial commit
Diffstat (limited to 'elpa/org-9.5.2/org-refile.el')
-rw-r--r--elpa/org-9.5.2/org-refile.el752
1 files changed, 752 insertions, 0 deletions
diff --git a/elpa/org-9.5.2/org-refile.el b/elpa/org-9.5.2/org-refile.el
new file mode 100644
index 0000000..678759e
--- /dev/null
+++ b/elpa/org-9.5.2/org-refile.el
@@ -0,0 +1,752 @@
+;;; org-refile.el --- Refile Org Subtrees -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten.dominik@gmail.com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;;
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org Refile allows you to refile subtrees to various locations.
+
+;;; Code:
+
+(require 'org)
+
+(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
+
+(defgroup org-refile nil
+ "Options concerning refiling entries in Org mode."
+ :tag "Org Refile"
+ :group 'org)
+
+(defcustom org-log-refile nil
+ "Information to record when a task is refiled.
+
+Possible values are:
+
+nil Don't add anything
+time Add a time stamp to the task
+note Prompt for a note and add it with template `org-log-note-headings'
+
+This option can also be set with on a per-file-basis with
+
+ #+STARTUP: nologrefile
+ #+STARTUP: logrefile
+ #+STARTUP: lognoterefile
+
+You can have local logging settings for a subtree by setting the LOGGING
+property to one or more of these keywords.
+
+When bulk-refiling, e.g., from the agenda, the value `note' is
+forbidden and will temporarily be changed to `time'."
+ :group 'org-refile
+ :group 'org-progress
+ :version "24.1"
+ :type '(choice
+ (const :tag "No logging" nil)
+ (const :tag "Record timestamp" time)
+ (const :tag "Record timestamp with note." note)))
+
+(defcustom org-refile-targets nil
+ "Targets for refiling entries with `\\[org-refile]'.
+This is a list of cons cells. Each cell contains:
+- a specification of the files to be considered, either a list of files,
+ or a symbol whose function or variable value will be used to retrieve
+ a file name or a list of file names. If you use `org-agenda-files' for
+ that, all agenda files will be scanned for targets. Nil means consider
+ headings in the current buffer.
+- A specification of how to find candidate refile targets. This may be
+ any of:
+ - a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
+ This tag has to be present in all target headlines, inheritance will
+ not be considered.
+ - a cons cell (:todo . \"KEYWORD\") to identify refile targets by
+ todo keyword.
+ - a cons cell (:regexp . \"REGEXP\") with a regular expression matching
+ headlines that are refiling targets.
+ - a cons cell (:level . N). Any headline of level N is considered a target.
+ Note that, when `org-odd-levels-only' is set, level corresponds to
+ order in hierarchy, not to the number of stars.
+ - a cons cell (:maxlevel . N). Any headline with level <= N is a target.
+ Note that, when `org-odd-levels-only' is set, level corresponds to
+ order in hierarchy, not to the number of stars.
+
+Each element of this list generates a set of possible targets.
+The union of these sets is presented (with completion) to
+the user by `org-refile'.
+
+You can set the variable `org-refile-target-verify-function' to a function
+to verify each headline found by the simple criteria above.
+
+When this variable is nil, all top-level headlines in the current buffer
+are used, equivalent to the value `((nil . (:level . 1))'."
+ :group 'org-refile
+ :type '(repeat
+ (cons
+ (choice :value org-agenda-files
+ (const :tag "All agenda files" org-agenda-files)
+ (const :tag "Current buffer" nil)
+ (function) (variable) (file))
+ (choice :tag "Identify target headline by"
+ (cons :tag "Specific tag" (const :value :tag) (string))
+ (cons :tag "TODO keyword" (const :value :todo) (string))
+ (cons :tag "Regular expression" (const :value :regexp) (regexp))
+ (cons :tag "Level number" (const :value :level) (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 and leave point
+where it is if the headline is a valid target for refiling.
+
+If the target should not be selected, the function must return nil.
+In addition to this, it may move point to a place from where the search
+should be continued. For example, the function may decide that the entire
+subtree of the current entry should be excluded and move point to the end
+of the subtree."
+ :group 'org-refile
+ :type '(choice
+ (const nil)
+ (function)))
+
+(defcustom org-refile-use-cache nil
+ "Non-nil means cache refile targets to speed up the process.
+\\<org-mode-map>\
+The cache for a particular file will be updated automatically when
+the buffer has been killed, or when any of the marker used for flagging
+refile targets no longer points at a live buffer.
+If you have added new entries to a buffer that might themselves be targets,
+you need to clear the cache manually by pressing `C-0 \\[org-refile]' or,
+if you find that easier, \
+`\\[universal-argument] \\[universal-argument] \\[universal-argument] \
+\\[org-refile]'."
+ :group 'org-refile
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-refile-use-outline-path nil
+ "Non-nil means provide refile targets as paths.
+So a level 3 headline will be available as level1/level2/level3.
+
+When the value is `file', also include the file name (without directory)
+into the path. In this case, you can also stop the completion after
+the file name, to get entries inserted as top level in the file.
+
+When `full-file-path', include the full file path.
+
+When `buffer-name', use the buffer name."
+ :group 'org-refile
+ :type '(choice
+ (const :tag "Not" nil)
+ (const :tag "Yes" t)
+ (const :tag "Start with file name" file)
+ (const :tag "Start with full file path" full-file-path)
+ (const :tag "Start with buffer name" buffer-name)))
+
+(defcustom org-outline-path-complete-in-steps t
+ "Non-nil means complete the outline path in hierarchical steps.
+When Org uses the refile interface to select an outline path (see
+`org-refile-use-outline-path'), the completion of the path can be
+done in a single go, or it can be done in steps down the headline
+hierarchy. Going in steps is probably the best if you do not use
+a special completion package like `ido' or `icicles'. However,
+when using these packages, going in one step can be very fast,
+while still showing the whole path to the entry."
+ :group 'org-refile
+ :type 'boolean)
+
+(defcustom org-refile-allow-creating-parent-nodes nil
+ "Non-nil means allow the creation of new nodes as refile targets.
+New nodes are then created by adding \"/new node name\" to the completion
+of an existing node. When the value of this variable is `confirm',
+new node creation must be confirmed by the user (recommended).
+When nil, the completion must match an existing entry.
+
+Note that, if the new heading is not seen by the criteria
+listed in `org-refile-targets', multiple instances of the same
+heading would be created by trying again to file under the new
+heading."
+ :group 'org-refile
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "Prompt for confirmation" confirm)))
+
+(defcustom org-refile-active-region-within-subtree nil
+ "Non-nil means also refile active region within a subtree.
+
+By default `org-refile' doesn't allow refiling regions if they
+don't contain a set of subtrees, but it might be convenient to
+do so sometimes: in that case, the first line of the region is
+converted to a headline before refiling."
+ :group 'org-refile
+ :version "24.1"
+ :type 'boolean)
+
+(defvar org-refile-target-table nil
+ "The list of refile targets, created by `org-refile'.")
+
+(defvar org-refile-cache nil
+ "Cache for refile targets.")
+
+(defvar org-refile-markers nil
+ "All the markers used for caching refile locations.")
+
+;; Add org refile commands to the main org menu
+(mapc (lambda (i) (easy-menu-add-item
+ org-org-menu
+ '("Edit Structure") i))
+ '(["Refile Subtree" org-refile (org-in-subtree-not-table-p)]
+ ["Refile and copy Subtree" org-refile-copy (org-in-subtree-not-table-p)]))
+
+(defun org-refile-marker (pos)
+ "Get a new refile marker, but only if caching is in use."
+ (if (not org-refile-use-cache)
+ pos
+ (let ((m (make-marker)))
+ (move-marker m pos)
+ (push m org-refile-markers)
+ m)))
+
+(defun org-refile-cache-clear ()
+ "Clear the refile cache and disable all the markers."
+ (dolist (m org-refile-markers) (move-marker m nil))
+ (setq org-refile-markers nil)
+ (setq org-refile-cache nil)
+ (message "Refile cache has been cleared"))
+
+(defun org-refile-cache-check-set (set)
+ "Check if all the markers in the cache still have live buffers."
+ (let (marker)
+ (catch 'exit
+ (while (and set (setq marker (nth 3 (pop set))))
+ ;; If `org-refile-use-outline-path' is 'file, marker may be nil
+ (when (and marker (null (marker-buffer marker)))
+ (message "Please regenerate the refile cache with `C-0 C-c C-w'")
+ (sit-for 3)
+ (throw 'exit nil)))
+ t)))
+
+(defun org-refile-cache-put (set &rest identifiers)
+ "Push the refile targets SET into the cache, under IDENTIFIERS."
+ (let* ((key (sha1 (prin1-to-string identifiers)))
+ (entry (assoc key org-refile-cache)))
+ (if entry
+ (setcdr entry set)
+ (push (cons key set) org-refile-cache))))
+
+(defun org-refile-cache-get (&rest identifiers)
+ "Retrieve the cached value for refile targets given by IDENTIFIERS."
+ (cond
+ ((not org-refile-cache) nil)
+ ((not org-refile-use-cache) (org-refile-cache-clear) nil)
+ (t
+ (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers))
+ org-refile-cache))))
+ (and set (org-refile-cache-check-set set) set)))))
+
+(defun org-refile-get-targets (&optional default-buffer)
+ "Produce a table with refile targets."
+ (let ((case-fold-search nil)
+ ;; otherwise org confuses "TODO" as a kw and "Todo" as a word
+ (entries (or org-refile-targets '((nil . (:level . 1)))))
+ targets tgs files desc descre)
+ (message "Getting targets...")
+ (with-current-buffer (or default-buffer (current-buffer))
+ (dolist (entry entries)
+ (setq files (car entry) desc (cdr entry))
+ (cond
+ ((null files) (setq files (list (current-buffer))))
+ ((eq files 'org-agenda-files)
+ (setq files (org-agenda-files 'unrestricted)))
+ ((and (symbolp files) (fboundp files))
+ (setq files (funcall files)))
+ ((and (symbolp files) (boundp files))
+ (setq files (symbol-value files))))
+ (when (stringp files) (setq files (list files)))
+ (cond
+ ((eq (car desc) :tag)
+ (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
+ ((eq (car desc) :todo)
+ (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
+ ((eq (car desc) :regexp)
+ (setq descre (cdr desc)))
+ ((eq (car desc) :level)
+ (setq descre (concat "^\\*\\{" (number-to-string
+ (if org-odd-levels-only
+ (1- (* 2 (cdr desc)))
+ (cdr desc)))
+ "\\}[ \t]")))
+ ((eq (car desc) :maxlevel)
+ (setq descre (concat "^\\*\\{1," (number-to-string
+ (if org-odd-levels-only
+ (1- (* 2 (cdr desc)))
+ (cdr desc)))
+ "\\}[ \t]")))
+ (t (error "Bad refiling target description %s" desc)))
+ (dolist (f files)
+ (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))
+ (or
+ (setq tgs (org-refile-cache-get (buffer-file-name) descre))
+ (progn
+ (when (bufferp f)
+ (setq f (buffer-file-name (buffer-base-buffer f))))
+ (setq f (and f (expand-file-name f)))
+ (when (eq org-refile-use-outline-path 'file)
+ (push (list (and f (file-name-nondirectory f)) f nil nil) tgs))
+ (when (eq org-refile-use-outline-path 'buffer-name)
+ (push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs))
+ (when (eq org-refile-use-outline-path 'full-file-path)
+ (push (list (and (buffer-file-name (buffer-base-buffer))
+ (file-truename (buffer-file-name (buffer-base-buffer))))
+ f nil nil) tgs))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (setq org-outline-path-cache nil)
+ (while (re-search-forward descre nil t)
+ (beginning-of-line)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
+ (let ((begin (point))
+ (heading (match-string-no-properties 4)))
+ (unless (or (and
+ org-refile-target-verify-function
+ (not
+ (funcall org-refile-target-verify-function)))
+ (not heading))
+ (let ((re (format org-complex-heading-regexp-format
+ (regexp-quote heading)))
+ (target
+ (if (not org-refile-use-outline-path) heading
+ (mapconcat
+ #'identity
+ (append
+ (pcase org-refile-use-outline-path
+ (`file (list
+ (and (buffer-file-name (buffer-base-buffer))
+ (file-name-nondirectory
+ (buffer-file-name (buffer-base-buffer))))))
+ (`full-file-path
+ (list (buffer-file-name
+ (buffer-base-buffer))))
+ (`buffer-name
+ (list (buffer-name
+ (buffer-base-buffer))))
+ (_ nil))
+ (mapcar (lambda (s) (replace-regexp-in-string
+ "/" "\\/" s nil t))
+ (org-get-outline-path t t)))
+ "/"))))
+ (push (list target f re (org-refile-marker (point)))
+ tgs)))
+ (when (= (point) begin)
+ ;; Verification function has not moved point.
+ (end-of-line)))))))
+ (when org-refile-use-cache
+ (org-refile-cache-put tgs (buffer-file-name) descre))
+ (setq targets (append tgs targets))))))
+ (message "Getting targets...done")
+ (delete-dups (nreverse targets))))
+
+(defvar org-refile-history nil
+ "History for refiling operations.")
+
+(defvar org-after-refile-insert-hook nil
+ "Hook run after `org-refile' has inserted its stuff at the new location.
+Note that this is still *before* the stuff will be removed from
+the *old* location.")
+
+(defvar org-refile-keep nil
+ "Non-nil means `org-refile' will copy instead of refile.")
+
+;;;###autoload
+(defun org-refile-copy ()
+ "Like `org-refile', but preserve the refiled subtree."
+ (interactive)
+ (let ((org-refile-keep t))
+ (org-refile nil nil nil "Copy")))
+
+;;;###autoload
+(defun org-refile-reverse (&optional arg default-buffer rfloc msg)
+ "Refile while temporarily toggling `org-reverse-note-order'.
+So if `org-refile' would append the entry as the last entry under
+the target heading, `org-refile-reverse' will prepend it as the
+first entry, and vice-versa."
+ (interactive "P")
+ (let ((org-reverse-note-order (not (org-notes-order-reversed-p))))
+ (org-refile arg default-buffer rfloc msg)))
+
+(defvar org-capture-last-stored-marker)
+
+
+;;;###autoload
+(defun org-refile (&optional arg default-buffer rfloc msg)
+ "Move the entry or entries at point to another heading.
+
+The list of target headings is compiled using the information in
+`org-refile-targets', which see.
+
+At the target location, the entry is filed as a subitem of the
+target heading. Depending on `org-reverse-note-order', the new
+subitem will either be the first or the last subitem.
+
+If there is an active region, all entries in that region will be
+refiled. However, the region must fulfill the requirement that
+the first heading sets the top-level of the moved text.
+
+With a `\\[universal-argument]' ARG, the command will only visit the target \
+location
+and not actually move anything.
+
+With a prefix `\\[universal-argument] \\[universal-argument]', go to the \
+location where the last
+refiling operation has put the subtree.
+
+With a numeric prefix argument of `2', refile to the running clock.
+
+With a numeric prefix argument of `3', emulate `org-refile-keep'
+being set to t and copy to the target location, don't move it.
+Beware that keeping refiled entries may result in duplicated ID
+properties.
+
+RFLOC can be a refile location obtained in a different way. It
+should be a list with the following 4 elements:
+
+1. Name - an identifier for the refile location, typically the
+headline text
+2. File - the file the refile location is in
+3. nil - used for generating refile location candidates, not
+needed when passing RFLOC
+4. Position - the position in the specified file of the
+headline to refile under
+
+MSG is a string to replace \"Refile\" in the default prompt with
+another verb. E.g. `org-refile-copy' sets this parameter to \"Copy\".
+
+See also `org-refile-use-outline-path'.
+
+If you are using target caching (see `org-refile-use-cache'), you
+have to clear the target cache in order to find new targets.
+This can be done with a `0' prefix (`C-0 C-c C-w') or a triple
+prefix argument (`C-u C-u C-u C-c C-w')."
+ (interactive "P")
+ (if (member arg '(0 (64)))
+ (org-refile-cache-clear)
+ (let* ((actionmsg (cond (msg msg)
+ ((equal arg 3) "Refile (and keep)")
+ (t "Refile")))
+ (regionp (org-region-active-p))
+ (region-start (and regionp (region-beginning)))
+ (region-end (and regionp (region-end)))
+ (org-refile-keep (if (equal arg 3) t org-refile-keep))
+ pos it nbuf file level reversed)
+ (setq last-command nil)
+ (when regionp
+ (goto-char region-start)
+ (beginning-of-line)
+ (setq region-start (point))
+ (unless (or (org-kill-is-subtree-p
+ (buffer-substring region-start region-end))
+ (prog1 org-refile-active-region-within-subtree
+ (let ((s (point-at-eol)))
+ (org-toggle-heading)
+ (setq region-end (+ (- (point-at-eol) s) region-end)))))
+ (user-error "The region is not a (sequence of) subtree(s)")))
+ (if (equal arg '(16))
+ (org-refile-goto-last-stored)
+ (when (or
+ (and (equal arg 2)
+ org-clock-hd-marker (marker-buffer org-clock-hd-marker)
+ (prog1
+ (setq it (list (or org-clock-heading "running clock")
+ (buffer-file-name
+ (marker-buffer org-clock-hd-marker))
+ ""
+ (marker-position org-clock-hd-marker)))
+ (setq arg nil)))
+ (setq it
+ (or rfloc
+ (let (heading-text)
+ (save-excursion
+ (unless (and arg (listp arg))
+ (org-back-to-heading t)
+ (setq heading-text
+ (replace-regexp-in-string
+ org-link-bracket-re
+ "\\2"
+ (or (nth 4 (org-heading-components))
+ ""))))
+ (org-refile-get-location
+ (cond ((and arg (listp arg)) "Goto")
+ (regionp (concat actionmsg " region to"))
+ (t (concat actionmsg " subtree \""
+ heading-text "\" to")))
+ default-buffer
+ (and (not (equal '(4) arg))
+ org-refile-allow-creating-parent-nodes)))))))
+ (setq file (nth 1 it)
+ pos (nth 3 it))
+ (when (and (not arg)
+ pos
+ (equal (buffer-file-name) file)
+ (if regionp
+ (and (>= pos region-start)
+ (<= pos region-end))
+ (and (>= pos (point))
+ (< pos (save-excursion
+ (org-end-of-subtree t t))))))
+ (error "Cannot refile to position inside the tree or region"))
+ (setq nbuf (or (find-buffer-visiting file)
+ (find-file-noselect file)))
+ (if (and arg (not (equal arg 3)))
+ (progn
+ (pop-to-buffer-same-window nbuf)
+ (goto-char (cond (pos)
+ ((org-notes-order-reversed-p) (point-min))
+ (t (point-max))))
+ (org-show-context 'org-goto))
+ (if regionp
+ (progn
+ (org-kill-new (buffer-substring region-start region-end))
+ (org-save-markers-in-region region-start region-end))
+ (org-copy-subtree 1 nil t))
+ (with-current-buffer (setq nbuf (or (find-buffer-visiting file)
+ (find-file-noselect file)))
+ (setq reversed (org-notes-order-reversed-p))
+ (org-with-wide-buffer
+ (if pos
+ (progn
+ (goto-char pos)
+ (setq level (org-get-valid-level (funcall outline-level) 1))
+ (goto-char
+ (if reversed
+ (or (outline-next-heading) (point-max))
+ (or (save-excursion (org-get-next-sibling))
+ (org-end-of-subtree t t)
+ (point-max)))))
+ (setq level 1)
+ (if (not reversed)
+ (goto-char (point-max))
+ (goto-char (point-min))
+ (or (outline-next-heading) (goto-char (point-max)))))
+ (unless (bolp) (newline))
+ (org-paste-subtree level nil nil t)
+ ;; Record information, according to `org-log-refile'.
+ ;; Do not prompt for a note when refiling multiple
+ ;; headlines, however. Simply add a time stamp.
+ (cond
+ ((not org-log-refile))
+ (regionp
+ (org-map-region
+ (lambda () (org-add-log-setup 'refile nil nil 'time))
+ (point)
+ (+ (point) (- region-end region-start))))
+ (t
+ (org-add-log-setup 'refile nil nil org-log-refile)))
+ (and org-auto-align-tags
+ (let ((org-loop-over-headlines-in-active-region nil))
+ (org-align-tags)))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-refile)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
+ ;; If we are refiling for capture, make sure that the
+ ;; last-capture pointers point here
+ (when (bound-and-true-p org-capture-is-refiling)
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture-marker)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
+ (move-marker org-capture-last-stored-marker (point)))
+ (when (fboundp 'deactivate-mark) (deactivate-mark))
+ (run-hooks 'org-after-refile-insert-hook)))
+ (unless org-refile-keep
+ (if regionp
+ (delete-region (point) (+ (point) (- region-end region-start)))
+ (org-preserve-local-variables
+ (delete-region
+ (and (org-back-to-heading t) (point))
+ (min (1+ (buffer-size)) (org-end-of-subtree t t) (point))))))
+ (when (featurep 'org-inlinetask)
+ (org-inlinetask-remove-END-maybe))
+ (setq org-markers-to-move nil)
+ (message "%s to \"%s\" in file %s: done" actionmsg
+ (car it) file)))))))
+
+(defun org-refile-goto-last-stored ()
+ "Go to the location where the last refile was stored."
+ (interactive)
+ (bookmark-jump (plist-get org-bookmark-names-plist :last-refile))
+ (message "This is the location of the last refile"))
+
+(defun org-refile--get-location (refloc tbl)
+ "When user refile to REFLOC, find the associated target in TBL.
+Also check `org-refile-target-table'."
+ (car (delq
+ nil
+ (mapcar
+ (lambda (r) (or (assoc r tbl)
+ (assoc r org-refile-target-table)))
+ (list (replace-regexp-in-string "/$" "" refloc)
+ (replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc))))))
+
+(defun org-refile-get-location (&optional prompt default-buffer new-nodes)
+ "Prompt the user for a refile location, using PROMPT.
+PROMPT should not be suffixed with a colon and a space, because
+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
+ (user-error "No refile targets"))
+ (let* ((cbuf (current-buffer))
+ (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
+ #'completing-read))
+ (extra (if org-refile-use-outline-path "/" ""))
+ (cbnex (concat (buffer-name) extra))
+ (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)
+ cdef
+ (prompt (concat prompt
+ (or (and (car org-refile-history)
+ (concat " (default " (car org-refile-history) ")"))
+ (and (assoc cbnex tbl) (setq cdef cbnex)
+ (concat " (default " cbnex ")"))) ": "))
+ 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
+ (or cdef (car org-refile-history))))
+ (if (setq pa (org-refile--get-location answ tbl))
+ (let ((last-refile-loc (car org-refile-history)))
+ (org-refile-check-position pa)
+ (when (or (not org-refile-history)
+ (not (eq old-hist org-refile-history))
+ (not (equal (car pa) last-refile-loc)))
+ (setq org-refile-history
+ (cons (car pa) (if (assoc last-refile-loc tbl)
+ org-refile-history
+ (cdr org-refile-history))))
+ (when (equal last-refile-loc (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 (org-refile--get-location 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)))
+ (user-error "Invalid target location")))))
+
+(defun org-refile-check-position (refile-pointer)
+ "Check if the refile pointer matches the headline to which it points."
+ (let* ((file (nth 1 refile-pointer))
+ (re (nth 2 refile-pointer))
+ (pos (nth 3 refile-pointer))
+ buffer)
+ (if (and (not (markerp pos)) (not file))
+ (user-error "Please indicate a target file in the refile path")
+ (when (org-string-nw-p re)
+ (setq buffer (if (markerp pos)
+ (marker-buffer pos)
+ (or (find-buffer-visiting file)
+ (find-file-noselect file))))
+ (with-current-buffer buffer
+ (org-with-wide-buffer
+ (goto-char pos)
+ (beginning-of-line 1)
+ (unless (looking-at-p re)
+ (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
+
+(defun org-refile-new-child (parent-target child)
+ "Use refile target PARENT-TARGET to add new CHILD below it."
+ (unless parent-target
+ (error "Cannot find parent for new node"))
+ (let ((file (nth 1 parent-target))
+ (pos (nth 3 parent-target))
+ level)
+ (with-current-buffer (or (find-buffer-visiting file)
+ (find-file-noselect file))
+ (org-with-wide-buffer
+ (if pos
+ (goto-char pos)
+ (goto-char (point-max))
+ (unless (bolp) (newline)))
+ (when (looking-at org-outline-regexp)
+ (setq level (funcall outline-level))
+ (org-end-of-subtree t t))
+ (org-back-over-empty-lines)
+ (insert "\n" (make-string
+ (if pos (org-get-valid-level level 1) 1) ?*)
+ " " child "\n")
+ (beginning-of-line 0)
+ (list (concat (car parent-target) "/" child) file "" (point))))))
+
+(defun org-olpath-completing-read (prompt collection &rest args)
+ "Read an outline path like a file name."
+ (let ((thetable collection))
+ (apply #'completing-read
+ prompt
+ (lambda (string predicate &optional flag)
+ (cond
+ ((eq flag nil) (try-completion string thetable))
+ ((eq flag t)
+ (let ((l (length string)))
+ (mapcar (lambda (x)
+ (let ((r (substring x l))
+ (f (if (string-match " ([^)]*)$" x)
+ (match-string 0 x)
+ "")))
+ (if (string-match "/" r)
+ (concat string (substring r 0 (match-end 0)) f)
+ x)))
+ (all-completions string thetable predicate))))
+ ;; Exact match?
+ ((eq flag 'lambda) (assoc string thetable))))
+ args)))
+
+(provide 'org-refile)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; org-refile.el ends here