Function: org-refile-get-targets

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

Signature

(org-refile-get-targets &optional DEFAULT-BUFFER)

Documentation

Produce a table with refile targets.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org-refile.el.gz
(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...")
    (cl-assert (listp entries) t "`org-refile-targets' must be a list of targets")
    (with-current-buffer (or default-buffer (current-buffer))
      (dolist (entry entries)
        (cl-assert (consp entry) t "Refile target must be a cons cell (FILES . SPECIFICATION)")
	(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)))
        ;; Allow commonly used (FILE :maxlevel N) and similar values.
        (when (and (listp (cdr desc)) (null (cddr desc)))
          (setq desc (cons (car desc) (cadr desc))))
        (condition-case err
	    (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)))
          (error
           (error "Error parsing refiling target description: %s"
                  (error-message-string err))))
	(dolist (f files)
	  (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))
            (unless (derived-mode-p 'org-mode)
              (error "Major mode in refile target buffer \"%s\" must be `org-mode'" 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))
               (when (eq org-refile-use-outline-path 'title)
                 (push (list (or (org-get-title)
                                 (and f (file-name-nondirectory f)))
                             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)
		  (forward-line 0)
		  (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))))))
                                   (`title (list
                                            (or (org-get-title)
                                                (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))))