Function: org-capture-set-target-location

org-capture-set-target-location is a byte-compiled function defined in org-capture.el.gz.

Signature

(org-capture-set-target-location &optional TARGET)

Documentation

Find TARGET buffer and position.

Store them in the capture property list.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org-capture.el.gz
(defvar org-time-was-given) ; dynamically scoped parameter
(defun org-capture-set-target-location (&optional target)
  "Find TARGET buffer and position.
Store them in the capture property list."
  (let ((target-entry-p t))
    (save-excursion
      (pcase (or target (org-capture-get :target))
	((or `here
             `(here))
	 (org-capture-put :exact-position (point) :insert-here t))
	(`(file ,path)
	 (set-buffer (org-capture-target-buffer path))
	 (org-capture-put-target-region-and-position)
	 (widen)
	 (setq target-entry-p nil))
	(`(id ,(and id (or (pred stringp) (pred symbolp))))
	 (pcase (org-id-find id)
	   (`(,path . ,position)
	    (set-buffer (org-capture-target-buffer path))
	    (widen)
	    (org-capture-put-target-region-and-position)
	    (goto-char position))
	   (_ (error "Cannot find target ID \"%s\"" id))))
	(`(file+headline ,path ,(and headline (pred stringp)))
	 (set-buffer (org-capture-target-buffer path))
	 ;; Org expects the target file to be in Org mode, otherwise
	 ;; it throws an error.  However, the default notes files
	 ;; should work out of the box.  In this case, we switch it to
	 ;; Org mode.
	 (unless (derived-mode-p 'org-mode)
	   (org-display-warning
	    (format "Capture requirement: switching buffer %S to Org mode"
		    (current-buffer)))
	   (org-mode))
	 (org-capture-put-target-region-and-position)
	 (widen)
	 (goto-char (point-min))
	 (if (re-search-forward (format org-complex-heading-regexp-format
					(regexp-quote headline))
				nil t)
	     (forward-line 0)
	   (goto-char (point-max))
	   (unless (bolp) (insert "\n"))
	   (insert "* " headline "\n")
	   (forward-line -1)))
	(`(file+olp ,path . ,(and outline-path (guard outline-path)))
	 (let ((m (org-find-olp (cons (org-capture-expand-file path)
				      outline-path))))
	   (set-buffer (marker-buffer m))
	   (org-capture-put-target-region-and-position)
	   (widen)
	   (goto-char m)
	   (set-marker m nil)))
	(`(file+regexp ,path ,(and regexp (pred stringp)))
	 (set-buffer (org-capture-target-buffer path))
	 (org-capture-put-target-region-and-position)
	 (widen)
	 (goto-char (point-min))
	 (if (not (re-search-forward regexp nil t))
	     (error "No match for target regexp in file %s" path)
	   (goto-char (if (org-capture-get :prepend)
			  (match-beginning 0)
			(match-end 0)))
	   (org-capture-put :exact-position (point))
	   (setq target-entry-p
		 (and (derived-mode-p 'org-mode) (org-at-heading-p)))))
	(`(file+olp+datetree ,path . ,outline-path)
	 (let ((m (if outline-path
		      (org-find-olp (cons (org-capture-expand-file path)
					  outline-path))
		    (set-buffer (org-capture-target-buffer path))
		    (point-marker))))
	   (set-buffer (marker-buffer m))
	   (org-capture-put-target-region-and-position)
	   (widen)
	   (goto-char m)
	   (set-marker m nil)
	   (require 'org-datetree)
	   (org-capture-put-target-region-and-position)
	   (widen)
	   ;; Make a date/week tree entry, with the current date (or
	   ;; yesterday, if we are extending dates for a couple of
	   ;; hours)
	   (funcall
	    (pcase (org-capture-get :tree-type)
	      (`week #'org-datetree-find-iso-week-create)
	      (`month #'org-datetree-find-month-create)
	      (_ #'org-datetree-find-date-create))
	    (calendar-gregorian-from-absolute
	     (cond
	      (org-overriding-default-time
	       ;; Use the overriding default time.
	       (time-to-days org-overriding-default-time))
	      ((or (org-capture-get :time-prompt)
		   (equal current-prefix-arg 1))
               ;; Prompt for date.  Bind `org-end-time-was-given' so
               ;; that `org-read-date-analyze' handles the time range
               ;; case and returns `prompt-time' with the start value.
               (let* ((org-time-was-given nil)
                      (org-end-time-was-given nil)
                      (prompt-time (org-read-date
				    nil t nil "Date for tree entry:")))
		 (org-capture-put
		  :default-time
                  (if (or org-time-was-given
                          (= (time-to-days prompt-time) (org-today)))
                      prompt-time
                    ;; Use 00:00 when no time is given for another
                    ;; date than today?
                    (org-encode-time
                     (apply #'list
                            0 0 org-extend-today-until
                            (cdddr (decode-time prompt-time))))))
		 (time-to-days prompt-time)))
	      (t
	       ;; Current date, possibly corrected for late night
	       ;; workers.
	       (org-today))))
	    ;; the following is the keep-restriction argument for
	    ;; org-datetree-find-date-create
	    (when outline-path 'subtree-at-point))))
	(`(file+function ,path ,(and function (pred functionp)))
	 (set-buffer (org-capture-target-buffer path))
	 (org-capture-put-target-region-and-position)
	 (widen)
	 (funcall function)
	 (org-capture-put :exact-position (point))
	 (setq target-entry-p
	       (and (derived-mode-p 'org-mode) (org-at-heading-p))))
	(`(function ,(and fun (pred functionp)))
	 (funcall fun)
	 (org-capture-put :exact-position (point))
	 (setq target-entry-p
	       (and (derived-mode-p 'org-mode) (org-at-heading-p))))
	(`(clock)
	 (if (and (markerp org-clock-hd-marker)
		  (marker-buffer org-clock-hd-marker))
	     (progn (set-buffer (marker-buffer org-clock-hd-marker))
		    (org-capture-put-target-region-and-position)
		    (widen)
		    (goto-char org-clock-hd-marker))
	   (user-error "No running clock that could be used as capture target")))
	(target (error "Invalid capture target specification: %S" target)))

      (org-capture-put :buffer (current-buffer)
		       :pos (point)
		       :target-entry-p target-entry-p
		       :decrypted
		       (and (featurep 'org-crypt)
			    (org-at-encrypted-entry-p)
			    (save-excursion
			      (org-decrypt-entry)
			      (and (org-back-to-heading t) (point))))))))