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 desc) (listp (cdr desc)) (null (cddr desc)))
          (setq desc (cons (car desc) (cadr desc))))
        (condition-case err
	    (cond
             ((eq desc t)
	      (setq descre (concat "^\\*+[ \t]")))
	     ((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)
		(let ((base (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))))
		  (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)
                                   (org-link-display-format heading)
                                 (mapconcat
				  #'identity
				  (append
				   base
				   (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))))