Function: org-refile-get-location

org-refile-get-location is a byte-compiled function defined in org-refile.el.gz.

Signature

(org-refile-get-location &optional PROMPT DEFAULT-BUFFER NEW-NODES)

Documentation

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.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org-refile.el.gz
(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 (file-truename cfn)))
	 (tbl (mapcar
	       (lambda (x)
		 (if (and (not (member org-refile-use-outline-path
				       '(file full-file-path title)))
			  (not (equal filename (file-truename (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 (let ((default (or (car org-refile-history)
                                    (and (assoc cbnex tbl) (setq cdef cbnex)
                                         cbnex))))
                   (org-format-prompt prompt default)))
	 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")))))