Function: org-store-link

org-store-link is an autoloaded, interactive and byte-compiled function defined in ol.el.gz.

Signature

(org-store-link ARG &optional INTERACTIVE\?)

Documentation

Store a link to the current location.

This link is added to org-stored-links and can later be inserted into an Org buffer with org-insert-link (C-c C-l (org-insert-link)).

For some link types, a C-u (universal-argument) prefix ARG is interpreted. A single C-u (universal-argument) negates org-context-in-file-links for file links or org-gnus-prefer-web-links for links to Usenet articles.

A C-u (universal-argument) C-u (universal-argument) prefix ARG forces skipping storing functions that are not part of Org core.

A C-u (universal-argument) C-u (universal-argument) C-u (universal-argument) prefix ARG forces storing a link for each line in the active region.

Assume the function is called interactively if INTERACTIVE? is non-nil.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/org/ol.el.gz
;;;###autoload
(defun org-store-link (arg &optional interactive?)
  "Store a link to the current location.
\\<org-mode-map>
This link is added to `org-stored-links' and can later be inserted
into an Org buffer with `org-insert-link' (`\\[org-insert-link]').

For some link types, a `\\[universal-argument]' prefix ARG is interpreted.  \
A single
`\\[universal-argument]' negates `org-context-in-file-links' for file links or
`org-gnus-prefer-web-links' for links to Usenet articles.

A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \
skipping storing functions that are not
part of Org core.

A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
prefix ARG forces storing a link for each line in the
active region.

Assume the function is called interactively if INTERACTIVE? is
non-nil."
  (interactive "P\np")
  (org-load-modules-maybe)
  (if (and (equal arg '(64)) (org-region-active-p))
      (save-excursion
	(let ((end (region-end)))
	  (goto-char (region-beginning))
	  (set-mark (point))
	  (while (< (point-at-eol) end)
	    (move-end-of-line 1) (activate-mark)
	    (let (current-prefix-arg)
	      (call-interactively 'org-store-link))
	    (move-beginning-of-line 2)
	    (set-mark (point)))))
    (setq org-store-link-plist nil)
    (let (link cpltxt desc search custom-id agenda-link) ;; description
      (cond
       ;; Store a link using an external link type, if any function is
       ;; available. If more than one can generate a link from current
       ;; location, ask which one to use.
       ((and (not (equal arg '(16)))
	     (let ((results-alist nil))
	       (dolist (f (org-store-link-functions))
		 (when (funcall f)
		   ;; XXX: return value is not link's plist, so we
		   ;; store the new value before it is modified.  It
		   ;; would be cleaner to ask store link functions to
		   ;; return the plist instead.
		   (push (cons f (copy-sequence org-store-link-plist))
			 results-alist)))
	       (pcase results-alist
		 (`nil nil)
		 (`((,_ . ,_)) t)	;single choice: nothing to do
		 (`((,name . ,_) . ,_)
		  ;; Reinstate link plist associated to the chosen
		  ;; function.
		  (apply #'org-link-store-props
			 (cdr (assoc-string
			       (completing-read
                                (format "Store link with (default %s): " name)
                                (mapcar #'car results-alist)
                                nil t nil nil (symbol-name name))
			       results-alist)))
		  t))))
	(setq link (plist-get org-store-link-plist :link))
        ;; If store function actually set `:description' property, use
        ;; it, even if it is nil.  Otherwise, fallback to link value.
	(setq desc (if (plist-member org-store-link-plist :description)
                       (plist-get org-store-link-plist :description)
		     link)))

       ;; Store a link from a remote editing buffer.
       ((org-src-edit-buffer-p)
	(let ((coderef-format (org-src-coderef-format))
	      (format-link
	       (lambda (label)
		 (if org-src-source-file-name
		     (format "file:%s::(%s)" org-src-source-file-name label)
		   (format "(%s)" label)))))
	  (cond
	   ;; Code references do not exist in this type of buffer.
	   ;; Pretend we're linking from the source buffer directly.
	   ((not (memq (org-src-source-type) '(example-block src-block)))
	    (with-current-buffer (org-src-source-buffer)
	      (org-store-link arg interactive?))
	    (setq link nil))
	   ;; A code reference exists.  Use it.
	   ((save-excursion
	      (beginning-of-line)
	      (re-search-forward (org-src-coderef-regexp coderef-format)
				 (line-end-position)
				 t))
	    (setq link (funcall format-link (match-string-no-properties 3))))
	   ;; No code reference.  Create a new one then store the link
	   ;; to it, but only in the function is called interactively.
	   (interactive?
	    (end-of-line)
	    (let* ((label (read-string "Code line label: "))
		   (reference (format coderef-format label))
		   (gc (- 79 (length reference))))
	      (if (< (current-column) gc)
		  (org-move-to-column gc t)
		(insert " "))
	      (insert reference)
	      (setq link (funcall format-link label))))
	   ;; No code reference, and non-interactive call.  Don't know
	   ;; what to do.  Give up.
	   (t (setq link nil)))))

       ;; We are in the agenda, link to referenced location
       ((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name))
	(let ((m (or (get-text-property (point) 'org-hd-marker)
		     (get-text-property (point) 'org-marker))))
	  (when m
	    (org-with-point-at m
	      (setq agenda-link (org-store-link nil interactive?))))))

       ((eq major-mode 'calendar-mode)
	(let ((cd (calendar-cursor-to-date)))
	  (setq link
		(format-time-string
		 (car org-time-stamp-formats)
		 (apply 'encode-time
			(list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
			      nil nil nil))))
	  (org-link-store-props :type "calendar" :date cd)))

       ((eq major-mode 'w3-mode)
	(setq cpltxt (if (and (buffer-name)
			      (not (string-match "Untitled" (buffer-name))))
			 (buffer-name)
		       (url-view-url t))
	      link (url-view-url t))
	(org-link-store-props :type "w3" :url (url-view-url t)))

       ((eq major-mode 'image-mode)
	(setq cpltxt (concat "file:"
			     (abbreviate-file-name buffer-file-name))
	      link cpltxt)
	(org-link-store-props :type "image" :file buffer-file-name))

       ;; In dired, store a link to the file of the current line
       ((derived-mode-p 'dired-mode)
	(let ((file (dired-get-filename nil t)))
	  (setq file (if file
			 (abbreviate-file-name
			  (expand-file-name (dired-get-filename nil t)))
		       ;; otherwise, no file so use current directory.
		       default-directory))
	  (setq cpltxt (concat "file:" file)
		link cpltxt)))

       ((setq search (run-hook-with-args-until-success
		      'org-create-file-search-functions))
	(setq link (concat "file:" (abbreviate-file-name buffer-file-name)
			   "::" search))
	(setq cpltxt (or link))) ;; description

       ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
	(org-with-limited-levels
         (cond
	  ;; Store a link using the target at point.
	  ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
	   (setq cpltxt
		 (concat "file:"
			 (abbreviate-file-name
			  (buffer-file-name (buffer-base-buffer)))
			 "::" (match-string 1))
		 link cpltxt))
          ;; Store a link using the CUSTOM_ID property.
          ((setq custom-id (org-entry-get nil "CUSTOM_ID"))
           (setq cpltxt
		 (concat "file:"
			 (abbreviate-file-name
			  (buffer-file-name (buffer-base-buffer)))
			 "::#" custom-id)
		 link cpltxt))
          ;; Store a link using (and perhaps creating) the ID property.
	  ((and (featurep 'org-id)
		(or (eq org-id-link-to-org-use-id t)
		    (and interactive?
			 (or (eq org-id-link-to-org-use-id 'create-if-interactive)
			     (and (eq org-id-link-to-org-use-id
				      'create-if-interactive-and-no-custom-id)
				  (not custom-id))))
		    (and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
	   (setq link (condition-case nil
			  (prog1 (org-id-store-link)
			    (setq desc (or (plist-get org-store-link-plist
						      :description)
					   "")))
			(error
			 ;; Probably before first headline, link only to file.
			 (concat "file:"
				 (abbreviate-file-name
				  (buffer-file-name (buffer-base-buffer))))))))
	  (t
	   ;; Just link to current headline.
	   (setq cpltxt (concat "file:"
				(abbreviate-file-name
				 (buffer-file-name (buffer-base-buffer)))))
	   ;; Add a context search string.
	   (when (org-xor org-link-context-for-files (equal arg '(4)))
	     (let* ((element (org-element-at-point))
		    (name (org-element-property :name element))
		    (context
		     (cond
		      ((let ((region (org-link--context-from-region)))
			 (and region (org-link--normalize-string region t))))
		      (name)
		      ((org-before-first-heading-p)
		       (org-link--normalize-string (org-current-line-string) t))
		      (t (org-link-heading-search-string)))))
	       (when (org-string-nw-p context)
		 (setq cpltxt (format "%s::%s" cpltxt context))
		 (setq desc
		       (or name
			   ;; Although description is not a search
			   ;; string, use `org-link--normalize-string'
			   ;; to prettify it (contiguous white spaces)
			   ;; and remove volatile contents (statistics
			   ;; cookies).
			   (and (not (org-before-first-heading-p))
				(org-link--normalize-string
				 (org-get-heading t t t t)))
			   "NONE")))))
	   (setq link cpltxt)))))

       ((buffer-file-name (buffer-base-buffer))
	;; Just link to this file here.
	(setq cpltxt (concat "file:"
			     (abbreviate-file-name
			      (buffer-file-name (buffer-base-buffer)))))
	;; Add a context search string.
	(when (org-xor org-link-context-for-files (equal arg '(4)))
	  (let ((context (org-link--normalize-string
			  (or (org-link--context-from-region)
			      (org-current-line-string))
			  t)))
	    ;; Only use search option if there is some text.
	    (when (org-string-nw-p context)
	      (setq cpltxt (format "%s::%s" cpltxt context))
	      (setq desc "NONE"))))
	(setq link cpltxt))

       (interactive?
	(user-error "No method for storing a link from this buffer"))

       (t (setq link nil)))

      ;; We're done setting link and desc, clean up
      (when (consp link) (setq cpltxt (car link) link (cdr link)))
      (setq link (or link cpltxt)
	    desc (or desc cpltxt))
      (cond ((not desc))
	    ((equal desc "NONE") (setq desc nil))
	    (t (setq desc (org-link-display-format desc))))
      ;; Store and return the link
      (if (not (and interactive? link))
	  (or agenda-link (and link (org-link-make-string link desc)))
	(if (member (list link desc) org-stored-links)
	    (message "This link has already been stored")
	  (push (list link desc) org-stored-links)
	  (message "Stored: %s" (or desc link))
	  (when custom-id
	    (setq link (concat "file:"
			       (abbreviate-file-name
				(buffer-file-name (buffer-base-buffer)))
			       "::#" custom-id))
	    (push (list link desc) org-stored-links)))
	(car org-stored-links)))))