diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2018-11-27 00:04:41 +0100 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2019-03-10 18:00:27 +0100 |
commit | a486d9cbd7491741554944a116f81b02f6b35e4b (patch) | |
tree | d393f79e852aab86e50aa3a69918e39eb9605848 | |
parent | 8060ca672731e35868df599dbe0953e505622477 (diff) | |
download | org-mode-a486d9cbd7491741554944a116f81b02f6b35e4b.tar.gz |
Move link-related core functions out of "org.el"
* contrib/lisp/org-wl.el (org-wl-store-link-message):
* lisp/Makefile (clean-install):
* lisp/ob-core.el (org-link-bracket-re):
(org-babel-open-src-block-result):
(org-babel-read-element):
(org-babel-read-link):
(org-babel-result-end):
* lisp/ob-tangle.el (org-link-bracket-re):
(org-babel-tangle-single-block):
(org-link-analytic-bracket-re):
(org-babel-detangle):
(org-babel-tangle-jump-to-org):
* lisp/ol.el:
* lisp/org-agenda.el (org-agenda-get-some-entry-text):
(org-diary):
(org-agenda-format-item):
(org-agenda-open-link):
(org-agenda-switch-to):
(org-agenda-to-appt):
* lisp/org-bbdb.el (org-bbdb-store-link):
* lisp/org-bibtex.el (org-bibtex-store-link):
* lisp/org-capture.el (org-capture-fill-template):
* lisp/org-clock.el (org-clocktable-write-default):
(org-clock-get-table-data):
* lisp/org-compat.el (org-doi-server-url):
(org-email-link-description-format):
(org-make-link-description-function):
(org-from-is-user-regexp):
(org-descriptive-links):
(org-url-hexify-p):
(org-context-in-file-links):
(org-keep-stored-link-after-insertion):
(org-display-internal-link-with-indirect-buffer):
(org-confirm-shell-link-function):
(org-confirm-shell-link-not-regexp):
(org-confirm-elisp-link-function):
(org-confirm-elisp-link-not-regexp):
(org-file-complete-link):
(org-email-link-description):
(org-make-link-string):
(org-store-link-props):
(org-add-link-props):
(org-make-link-regexps):
(org-angle-link-re):
(org-plain-link-re):
(org-bracket-link-regexp):
(org-bracket-link-analytic-regexp):
(org-any-link-re):
* lisp/org-docview.el (org-docview-store-link):
(org-docview-complete-link):
* lisp/org-element.el (org-element-link-parser):
* lisp/org-eshell.el (org-eshell-store-link):
* lisp/org-eww.el (org-eww-store-link):
(org-eww-copy-for-org-mode):
* lisp/org-footnote.el (org-footnote-next-reference-or-definition):
* lisp/org-gnus.el (org-gnus-article-link):
(org-gnus-store-link):
* lisp/org-id.el (org-id-store-link):
* lisp/org-info.el (org-info-store-link):
* lisp/org-irc.el (org-irc-erc-store-link):
* lisp/org-mhe.el (org-mhe-store-link):
* lisp/org-pcomplete.el (pcomplete/org-mode/searchhead):
* lisp/org-protocol.el (org-protocol-do-capture):
* lisp/org-rmail.el (org-rmail-store-link):
* lisp/org-w3m.el (org-w3m-store-link):
(org-w3m-copy-for-org-mode):
-rw-r--r-- | contrib/lisp/ob-smiles.el | 2 | ||||
-rw-r--r-- | contrib/lisp/org-vm.el | 6 | ||||
-rw-r--r-- | contrib/lisp/org-wl.el | 6 | ||||
-rw-r--r-- | lisp/Makefile | 2 | ||||
-rw-r--r-- | lisp/ob-core.el | 10 | ||||
-rw-r--r-- | lisp/ob-tangle.el | 14 | ||||
-rw-r--r-- | lisp/ol.el | 1924 | ||||
-rw-r--r-- | lisp/org-agenda.el | 23 | ||||
-rw-r--r-- | lisp/org-bbdb.el | 4 | ||||
-rw-r--r-- | lisp/org-bibtex.el | 4 | ||||
-rw-r--r-- | lisp/org-capture.el | 8 | ||||
-rw-r--r-- | lisp/org-clock.el | 11 | ||||
-rw-r--r-- | lisp/org-colview.el | 4 | ||||
-rw-r--r-- | lisp/org-compat.el | 85 | ||||
-rw-r--r-- | lisp/org-docview.el | 6 | ||||
-rw-r--r-- | lisp/org-element.el | 16 | ||||
-rw-r--r-- | lisp/org-eshell.el | 4 | ||||
-rw-r--r-- | lisp/org-eww.el | 8 | ||||
-rw-r--r-- | lisp/org-footnote.el | 4 | ||||
-rw-r--r-- | lisp/org-gnus.el | 27 | ||||
-rw-r--r-- | lisp/org-id.el | 4 | ||||
-rw-r--r-- | lisp/org-info.el | 4 | ||||
-rw-r--r-- | lisp/org-irc.el | 6 | ||||
-rw-r--r-- | lisp/org-lint.el | 12 | ||||
-rw-r--r-- | lisp/org-mhe.el | 10 | ||||
-rw-r--r-- | lisp/org-mobile.el | 3 | ||||
-rw-r--r-- | lisp/org-pcomplete.el | 5 | ||||
-rw-r--r-- | lisp/org-protocol.el | 5 | ||||
-rw-r--r-- | lisp/org-rmail.el | 10 | ||||
-rw-r--r-- | lisp/org-w3m.el | 8 | ||||
-rw-r--r-- | lisp/org.el | 2624 | ||||
-rw-r--r-- | lisp/ox.el | 9 |
32 files changed, 2516 insertions, 2352 deletions
diff --git a/contrib/lisp/ob-smiles.el b/contrib/lisp/ob-smiles.el index ef2ab15..9f4f140 100644 --- a/contrib/lisp/ob-smiles.el +++ b/contrib/lisp/ob-smiles.el @@ -25,7 +25,7 @@ (defun molecule-jump (name) "Jump to molecule `NAME' definition." (org-mark-ring-push) - (org-open-link-from-string (format "[[%s]]" path))) + (org-link-open-from-string (format "[[%s]]" path))) (defun molecule-export (path desc backend) "Export molecule to HTML format on `PATH' with `DESC' and `BACKEND'." diff --git a/contrib/lisp/org-vm.el b/contrib/lisp/org-vm.el index 1113e29..1a2569c 100644 --- a/contrib/lisp/org-vm.el +++ b/contrib/lisp/org-vm.el @@ -107,7 +107,7 @@ (defun org-vm-follow-link (&optional folder article readonly) "Follow a VM link to FOLDER and ARTICLE." (require 'vm) - (setq article (org-add-angle-brackets article)) + (setq article (org-link-add-angle-brackets article)) (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder) ;; ange-ftp or efs or tramp access (let ((user (or (match-string 1 folder) (user-login-name))) @@ -124,7 +124,7 @@ (when folder (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) (when article - (org-vm-select-message (org-add-angle-brackets article))))) + (org-vm-select-message (org-link-add-angle-brackets article))))) (defun org-vm-imap-open (path) "Follow a VM link to an IMAP folder." @@ -143,7 +143,7 @@ (funcall (cdr (assq 'vm-imap org-link-frame-setup)) mailbox-spec) (when message-id - (org-vm-select-message (org-add-angle-brackets message-id)))))) + (org-vm-select-message (org-link-add-angle-brackets message-id)))))) (defun org-vm-select-message (message-id) "Go to the message with message-id in the current folder." diff --git a/contrib/lisp/org-wl.el b/contrib/lisp/org-wl.el index 4ac9a53..897c272 100644 --- a/contrib/lisp/org-wl.el +++ b/contrib/lisp/org-wl.el @@ -221,10 +221,10 @@ ENTITY is a message entity." ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links) (setq link (format - (if (string-match "gmane\\." folder-name) + (if (string-match-p "gmane\\." folder-name) "http://mid.gmane.org/%s" "http://groups.google.com/groups/search?as_umsgid=%s") - (org-fixup-message-id-for-http message-id))) + (url-encode-url message-id))) (org-store-link-props :type "http" :link link :description subject :from from :to to :message-id message-id :message-id-no-brackets message-id-no-brackets @@ -291,7 +291,7 @@ for namazu index." (goto-char old-point)) (when article (if (string-match-p "@" article) - (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets + (wl-summary-jump-to-msg-by-message-id (org-link-add-angle-brackets article)) (or (wl-summary-jump-to-msg (string-to-number article)) (error "No such message: %s" article))) diff --git a/lisp/Makefile b/lisp/Makefile index 89f504d..f2a14b5 100644 --- a/lisp/Makefile +++ b/lisp/Makefile @@ -89,5 +89,5 @@ clean cleanall cleanelc:: clean-install: if [ -d $(DESTDIR)$(lispdir) ] ; then \ - $(RM) $(DESTDIR)$(lispdir)/org*.el* $(DESTDIR)$(lispdir)/ob*.el* $(DESTDIR)$(lispdir)/ox*.el* ; \ + $(RM) $(DESTDIR)$(lispdir)/org*.el* $(DESTDIR)$(lispdir)/ob*.el* $(DESTDIR)$(lispdir)/ol*.el* $(DESTDIR)$(lispdir)/ox*.el* ; \ fi ; diff --git a/lisp/ob-core.el b/lisp/ob-core.el index df96af8..fbeb46b 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -1023,7 +1023,7 @@ evaluation mechanisms." (call-interactively (key-binding (or key (read-key-sequence nil)))))) -(defvar org-bracket-link-regexp) +(defvar org-link-bracket-re) (defun org-babel-active-location-p () (memq (org-element-type (save-match-data (org-element-context))) @@ -1049,7 +1049,7 @@ exist." (end-of-line) (skip-chars-forward " \r\t\n") ;; Open the results. - (if (looking-at org-bracket-link-regexp) (org-open-at-point) + (if (looking-at org-link-bracket-re) (org-open-at-point) (let ((r (org-babel-format-result (org-babel-read-result) (cdr (assq :sep arguments))))) (pop-to-buffer (get-buffer-create "*Org Babel Results*")) @@ -2093,7 +2093,7 @@ Return nil if ELEMENT cannot be read." (`paragraph ;; Treat paragraphs containing a single link specially. (skip-chars-forward " \t") - (if (and (looking-at org-bracket-link-regexp) + (if (and (looking-at org-link-bracket-re) (save-excursion (goto-char (match-end 0)) (skip-chars-forward " \r\t\n") @@ -2135,7 +2135,7 @@ Return nil if ELEMENT cannot be read." If the path of the link is a file path it is expanded using `expand-file-name'." (let* ((case-fold-search t) - (raw (and (looking-at org-bracket-link-regexp) + (raw (and (looking-at org-link-bracket-re) (org-no-properties (match-string 1)))) (type (and (string-match org-link-types-re raw) (match-string 1 raw)))) @@ -2479,7 +2479,7 @@ in the buffer." (defun org-babel-result-end () "Return the point at the end of the current set of results." (cond ((looking-at-p "^[ \t]*$") (point)) ;no result - ((looking-at-p (format "^[ \t]*%s[ \t]*$" org-bracket-link-regexp)) + ((looking-at-p (format "^[ \t]*%s[ \t]*$" org-link-bracket-re)) (line-beginning-position 2)) (t (let ((element (org-element-at-point))) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index dbab56f..fa5ba80 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -43,7 +43,7 @@ (declare-function org-id-find "org-id" (id &optional markerp)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-link-escape "org" (text &optional table merge)) -(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) +(declare-function org-link-open-from-string "ol" (s &optional arg)) (declare-function org-store-link "org" (arg &optional interactive?)) (declare-function outline-previous-heading "outline" ()) @@ -332,7 +332,7 @@ references." (save-excursion (end-of-line 1) (forward-char 1) (point))))) (defvar org-stored-links) -(defvar org-bracket-link-regexp) +(defvar org-link-bracket-re) (defun org-babel-spec-to-string (spec) "Insert SPEC into the current file. @@ -428,7 +428,7 @@ non-nil, return the full association list to be used by (match-string 1 extra)) org-coderef-label-format)) (link (let ((l (org-no-properties (org-store-link nil)))) - (and (string-match org-bracket-link-regexp l) + (and (string-match org-link-bracket-re l) (match-string 1 l)))) (source-name (or (nth 4 info) @@ -517,7 +517,7 @@ non-nil, return the full association list to be used by (org-fill-template org-babel-tangle-comment-format-end link-data)))) ;; de-tangling functions -(defvar org-bracket-link-analytic-regexp) +(defvar org-link-analytic-bracket-re) (defun org-babel-detangle (&optional source-code-file) "Propagate changes in source file back original to Org file. This requires that code blocks were tangled with link comments @@ -527,7 +527,7 @@ which enable the original code blocks to be found." (when source-code-file (find-file source-code-file)) (goto-char (point-min)) (let ((counter 0) new-body end) - (while (re-search-forward org-bracket-link-analytic-regexp nil t) + (while (re-search-forward org-link-analytic-bracket-re nil t) (when (re-search-forward (concat " " (regexp-quote (match-string 5)) " ends here")) (setq end (match-end 0)) @@ -547,7 +547,7 @@ which enable the original code blocks to be found." target-buffer target-char link path block-name body) (save-window-excursion (save-excursion - (while (and (re-search-backward org-bracket-link-analytic-regexp nil t) + (while (and (re-search-backward org-link-analytic-bracket-re nil t) (not ; ever wider searches until matching block comments (and (setq start (line-beginning-position)) (setq body-start (line-beginning-position 2)) @@ -568,7 +568,7 @@ which enable the original code blocks to be found." (find-file (or (car (org-id-find path)) path)) (setq target-buffer (current-buffer)) ;; Go to the beginning of the relative block in Org file. - (org-open-link-from-string link) + (org-link-open-from-string link) (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name) (let ((n (string-to-number (match-string 1 block-name)))) (if (org-before-first-heading-p) (goto-char (point-min)) diff --git a/lisp/ol.el b/lisp/ol.el new file mode 100644 index 0000000..f260c07 --- /dev/null +++ b/lisp/ol.el @@ -0,0 +1,1924 @@ +;;; ol.el --- Org links library -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library provides tooling to handle both external and internal +;; links. + +;;; Code: + +(require 'org-compat) +(require 'org-macs) + +(defvar clean-buffer-list-kill-buffer-names) +(defvar org-agenda-buffer-name) +(defvar org-comment-string) +(defvar org-highlight-links) +(defvar org-id-link-to-org-use-id) +(defvar org-inhibit-startup) +(defvar org-outline-regexp-bol) +(defvar org-src-source-file-name) +(defvar org-time-stamp-formats) +(defvar org-ts-regexp) + +(declare-function calendar-cursor-to-date "calendar" (&optional error event)) +(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) +(declare-function mailcap-extension-to-mime "mailcap" (extn)) +(declare-function mailcap-mime-info (string &optional request no-decode)) +(declare-function mailcap-parse-mailcaps "mailcap" (&optional path force)) +(declare-function org-at-heading-p "org" (&optional _)) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-context "org" ()) +(declare-function org-do-occur "org" (regexp &optional cleanup)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-cache-refresh "org-element" (pos)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-lineage "org-element" (datum &optional types with-self)) +(declare-function org-element-link-parser "org-element" ()) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-element-update-syntax "org-element" ()) +(declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) +(declare-function org-find-property "org" (property &optional value)) +(declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment)) +(declare-function org-heading-components "org" ()) +(declare-function org-id-find-id-file "org-id" (id)) +(declare-function org-id-store-link "org-id" ()) +(declare-function org-insert-heading "org" (&optional arg invisible-ok top)) +(declare-function org-load-modules-maybe "org" (&optional force)) +(declare-function org-mark-ring-push "org" (&optional pos buffer)) +(declare-function org-occur "org" (regexp &optional keep-previous callback)) +(declare-function org-open-file "org" (path &optional in-emacs line search)) +(declare-function org-overview "org" ()) +(declare-function org-restart-font-lock "org" ()) +(declare-function org-show-context "org" (&optional key)) +(declare-function org-src-coderef-format "org-src" (&optional element)) +(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) +(declare-function org-src-edit-buffer-p "org-src" (&optional buffer)) +(declare-function org-src-source-buffer "org-src" ()) +(declare-function org-src-source-type "org-src" ()) +(declare-function org-time-stamp-format "org" (&optional long inactive)) +(declare-function outline-next-heading "outline" ()) + + +;;; Customization + +(defgroup org-link nil + "Options concerning links in Org mode." + :tag "Org Link" + :group 'org) + +(defcustom org-link-parameters nil + "An alist of properties that defines all the links in Org mode. +The key in each association is a string of the link type. +Subsequent optional elements make up a plist of link properties. + +:follow - A function that takes the link path as an argument. + +:export - A function that takes the link path, description and +export-backend as arguments. + +:store - A function responsible for storing the link. See the +function `org-store-link-functions'. + +:complete - A function that inserts a link with completion. The +function takes one optional prefix argument. + +:face - A face for the link, or a function that returns a face. +The function takes one argument which is the link path. The +default face is `org-link'. + +:mouse-face - The mouse-face. The default is `highlight'. + +:display - `full' will not fold the link in descriptive +display. Default is `org-link'. + +:help-echo - A string or function that takes (window object position) +as arguments and returns a string. + +:keymap - A keymap that is active on the link. The default is +`org-mouse-map'. + +:htmlize-link - A function for the htmlize-link. Defaults +to (list :uri \"type:path\") + +:activate-func - A function to run at the end of font-lock +activation. The function must accept (link-start link-end path bracketp) +as arguments." + :group 'org-link + :package-version '(Org . "9.1") + :type '(alist :tag "Link display parameters" + :value-type plist) + :safe nil) + +(defcustom org-link-descriptive t + "Non-nil means Org displays descriptive links. + +E.g. [[https://orgmode.org][Org website]] is be displayed as +\"Org Website\", hiding the link itself and just displaying its +description. When set to nil, Org displays the full links +literally. + +You can interactively set the value of this variable by calling +`org-toggle-link-display' or from the \"Org > Hyperlinks\" menu." + :group 'org-link + :type 'boolean + :safe #'booleanp) + +(defcustom org-link-make-description-function nil + "Function to use for generating link descriptions from links. +This function must take two parameters: the first one is the +link, the second one is the description generated by +`org-insert-link'. The function should return the description to +use." + :group 'org-link + :type '(choice (const nil) (function)) + :safe #'null) + +(defcustom org-link-file-path-type 'adaptive + "How the path name in file links should be stored. +Valid values are: + +relative Relative to the current directory, i.e. the directory of the file + into which the link is being inserted. +absolute Absolute path, if possible with ~ for home directory. +noabbrev Absolute path, no abbreviation of home directory. +adaptive Use relative path for files in the current directory and sub- + directories of it. For other files, use an absolute path." + :group 'org-link + :type '(choice + (const relative) + (const absolute) + (const noabbrev) + (const adaptive)) + :safe #'symbolp) + +(defcustom org-link-abbrev-alist nil + "Alist of link abbreviations. +The car of each element is a string, to be replaced at the start of a link. +The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated +links in Org buffers can have an optional tag after a double colon, e.g., + + [[linkkey:tag][description]] + +The `linkkey' must be a single word, starting with a letter, followed +by letters, numbers, `-' or `_'. + +If REPLACE is a string, the tag will simply be appended to create the link. +If the string contains \"%s\", the tag will be inserted there. If the string +contains \"%h\", it will cause a url-encoded version of the tag to be inserted +at that point (see the function `url-hexify-string'). If the string contains +the specifier \"%(my-function)\", then the custom function `my-function' will +be invoked: this function takes the tag as its only argument and must return +a string. + +REPLACE may also be a function that will be called with the tag as the +only argument to create the link, which should be returned as a string. + +See the manual for examples." + :group 'org-link + :type '(repeat + (cons (string :tag "Protocol") + (choice + (string :tag "Format") + (function)))) + :safe (lambda (val) + (pcase val + (`(,(pred stringp) . ,(pred stringp)) t) + (_ nil)))) + +(defgroup org-link-follow nil + "Options concerning following links in Org mode." + :tag "Org Follow Link" + :group 'org-link) + +(defcustom org-link-translation-function nil + "Function to translate links with different syntax to Org syntax. +This can be used to translate links created for example by the Planner +or emacs-wiki packages to Org syntax. +The function must accept two parameters, a TYPE containing the link +protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, +which is everything after the link protocol. It should return a cons +with possibly modified values of type and path. +Org contains a function for this, so if you set this variable to +`org-translate-link-from-planner', you should be able follow many +links created by planner." + :group 'org-link-follow + :type '(choice (const nil) (function)) + :safe #'null) + +(defcustom org-link-doi-server-url "http://dx.doi.org/" + "The URL of the DOI server." + :group 'org-link-follow + :version "24.3" + :type 'string + :safe #'stringp) + +(defcustom org-link-frame-setup + '((vm . vm-visit-folder-other-frame) + (vm-imap . vm-visit-imap-folder-other-frame) + (gnus . org-gnus-no-new-news) + (file . find-file-other-window) + (wl . wl-other-frame)) + "Setup the frame configuration for following links. +When following a link with Emacs, it may often be useful to display +this link in another window or frame. This variable can be used to +set this up for the different types of links. +For VM, use any of + `vm-visit-folder' + `vm-visit-folder-other-window' + `vm-visit-folder-other-frame' +For Gnus, use any of + `gnus' + `gnus-other-frame' + `org-gnus-no-new-news' +For FILE, use any of + `find-file' + `find-file-other-window' + `find-file-other-frame' +For Wanderlust use any of + `wl' + `wl-other-frame' +For the calendar, use the variable `calendar-setup'. +For BBDB, it is currently only possible to display the matches in +another window." + :group 'org-link-follow + :type '(list + (cons (const vm) + (choice + (const vm-visit-folder) + (const vm-visit-folder-other-window) + (const vm-visit-folder-other-frame))) + (cons (const vm-imap) + (choice + (const vm-visit-imap-folder) + (const vm-visit-imap-folder-other-window) + (const vm-visit-imap-folder-other-frame))) + (cons (const gnus) + (choice + (const gnus) + (const gnus-other-frame) + (const org-gnus-no-new-news))) + (cons (const file) + (choice + (const find-file) + (const find-file-other-window) + (const find-file-other-frame))) + (cons (const wl) + (choice + (const wl) + (const wl-other-frame)))) + :safe nil) + +(defcustom org-link-search-must-match-exact-headline 'query-to-create + "Non-nil means internal fuzzy links can only match headlines. + +When nil, the a fuzzy link may point to a target or a named +construct in the document. When set to the special value +`query-to-create', offer to create a new headline when none +matched. + +Spaces and statistics cookies are ignored during heading searches." + :group 'org-link-follow + :version "24.1" + :type '(choice + (const :tag "Use fuzzy text search" nil) + (const :tag "Match only exact headline" t) + (const :tag "Match exact headline or query to create it" + query-to-create)) + :safe #'symbolp) + +(defcustom org-link-use-indirect-buffer-for-internals nil + "Non-nil means use indirect buffer to display infile links. +Activating internal links (from one location in a file to another location +in the same file) normally just jumps to the location. When the link is +activated with a `\\[universal-argument]' prefix (or with mouse-3), the link \ +is displayed in +another window. When this option is set, the other window actually displays +an indirect buffer clone of the current buffer, to avoid any visibility +changes to the current buffer." + :group 'org-link-follow + :type 'boolean + :safe #'booleanp) + +(defcustom org-link-shell-confirm-function 'yes-or-no-p + "Non-nil means ask for confirmation before executing shell links. + +Shell links can be dangerous: just think about a link + + [[shell:rm -rf ~/*][Google Search]] + +This link would show up in your Org document as \"Google Search\", +but really it would remove your entire home directory. +Therefore we advise against setting this variable to nil. +Just change it to `y-or-n-p' if you want to confirm with a +single keystroke rather than having to type \"yes\"." + :group 'org-link-follow + :type '(choice + (const :tag "with yes-or-no (safer)" yes-or-no-p) + (const :tag "with y-or-n (faster)" y-or-n-p) + (const :tag "no confirmation (dangerous)" nil)) + :safe nil) + +(defcustom org-link-shell-skip-confirm-regexp "" + "Regexp to skip confirmation for shell links." + :group 'org-link-follow + :version "24.1" + :type 'regexp + :safe nil) + +(defcustom org-link-elisp-confirm-function 'yes-or-no-p + "Non-nil means ask for confirmation before executing Emacs Lisp links. +Elisp links can be dangerous: just think about a link + + [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] + +This link would show up in your Org document as \"Google Search\", +but really it would remove your entire home directory. +Therefore we advise against setting this variable to nil. +Just change it to `y-or-n-p' if you want to confirm with a +single keystroke rather than having to type \"yes\"." + :group 'org-link-follow + :type '(choice + (const :tag "with yes-or-no (safer)" yes-or-no-p) + (const :tag "with y-or-n (faster)" y-or-n-p) + (const :tag "no confirmation (dangerous)" nil)) + :safe nil) + +(defcustom org-link-elisp-skip-confirm-regexp "" + "A regexp to skip confirmation for Elisp links." + :group 'org-link-follow + :version "24.1" + :type 'regexp + :safe nil) + +(defgroup org-link-store nil + "Options concerning storing links in Org mode." + :tag "Org Store Link" + :group 'org-link) + +(defcustom org-link-url-hexify t + "When non-nil, hexify URL when creating a link." + :type 'boolean + :version "24.3" + :group 'org-link-store + :safe #'booleanp) + +(defcustom org-link-context-for-files t + "Non-nil means file links from `org-store-link' contain context. +\\<org-mode-map> +A search string is added to the file name with \"::\" as separator +and used to find the context when the link is activated by the command +`org-open-at-point'. When this option is t, the entire active region +is be placed in the search string of the file link. If set to a +positive integer N, only the first N lines of context are stored. + +Using a prefix argument to the command `org-store-link' \ +\(`\\[universal-argument] \\[org-store-link]') +negates this setting for the duration of the command." + :group 'org-link-store + :type '(choice boolean integer) + :safe (lambda (val) (or (booleanp val) (integerp val)))) + +(defcustom org-link-email-description-format "Email %c: %s" + "Format of the description part of a link to an email or usenet message. +The following %-escapes will be replaced by corresponding information: + +%F full \"From\" field +%f name, taken from \"From\" field, address if no name +%T full \"To\" field +%t first name in \"To\" field, address if no name +%c correspondent. Usually \"from NAME\", but if you sent it yourself, it + will be \"to NAME\". See also the variable `org-from-is-user-regexp'. +%s subject +%d date +%m message-id. + +You may use normal field width specification between the % and the letter. +This is for example useful to limit the length of the subject. + +Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\"" + :group 'org-link-store + :package-version '(Org . 9.3) + :type 'string + :safe #'stringp) + +(defcustom org-link-from-user-regexp + (let ((mail (and (org-string-nw-p user-mail-address) + (format "\\<%s\\>" (regexp-quote user-mail-address)))) + (name (and (org-string-nw-p user-full-name) + (format "\\<%s\\>" (regexp-quote user-full-name))))) + (if (and mail name) (concat mail "\\|" name) (or mail name))) + "Regexp matched against the \"From:\" header of an email or Usenet message. +It should match if the message is from the user him/herself." + :group 'org-link-store + :type 'regexp + :safe #'stringp) + +(defcustom org-link-keep-stored-after-insertion nil + "Non-nil means keep link in list for entire session. +\\<org-mode-map> +The command `org-store-link' adds a link pointing to the current +location to an internal list. These links accumulate during a session. +The command `org-insert-link' can be used to insert links into any +Org file (offering completion for all stored links). + +When this option is nil, every link which has been inserted once using +`\\[org-insert-link]' will be removed from the list, to make completing the \ +unused +links more efficient." + :group 'org-link-store + :type 'boolean + :safe #'booleanp) + +;;; Public variables + +(defconst org-link-escape-chars + ;;%20 %5B %5D %25 + '(?\s ?\[ ?\] ?%) + "List of characters that should be escaped in a link when stored to Org. +This is the list that is used for internal purposes.") + +(defconst org-target-regexp (let ((border "[^<>\n\r \t]")) + (format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>" + border border border)) + "Regular expression matching a link target.") + +(defconst org-radio-target-regexp (format "<%s>" org-target-regexp) + "Regular expression matching a radio target.") + +(defvar-local org-target-link-regexp nil + "Regular expression matching radio targets in plain text.") + +(defvar org-link-types-re nil + "Matches a link that has a url-like prefix like \"http:\"") + +(defvar org-link-re-with-space nil + "Matches a link with spaces, optional angular brackets around it.") + +(defvar org-link-re-with-space2 nil + "Matches a link with spaces, optional angular brackets around it.") + +(defvar org-link-re-with-space3 nil + "Matches a link with spaces, only for internal part in bracket links.") + +(defvar org-link-angle-re nil + "Matches link with angular brackets, spaces are allowed.") + +(defvar org-link-plain-re nil + "Matches plain link, without spaces.") + +(defvar org-link-bracket-re nil + "Matches a link in double brackets.") + +(defvar org-link-analytic-bracket-re nil + "Regular expression used to analyze links. +Here is what the match groups contain after a match: +1: http: +2: http +3: path +4: [desc] +5: desc") + +(defvar org-link-any-re nil + "Regular expression matching any link.") + +(defvar-local org-link-abbrev-alist-local nil + "Buffer-local version of `org-link-abbrev-alist', which see. +The value of this is taken from the LINK keywords.") + +(defvar org-stored-links nil + "Contains the links stored with `org-store-link'.") + +(defvar org-store-link-plist nil + "Plist with info about the most recently link created with `org-store-link'.") + +(defvar org-create-file-search-functions nil + "List of functions to construct the right search string for a file link. + +These functions are called in turn with point at the location to +which the link should point. + +A function in the hook should first test if it would like to +handle this file type, for example by checking the `major-mode' +or the file extension. If it decides not to handle this file, it +should just return nil to give other functions a chance. If it +does handle the file, it must return the search string to be used +when following the link. The search string will be part of the +file link, given after a double colon, and `org-open-at-point' +will automatically search for it. If special measures must be +taken to make the search successful, another function should be +added to the companion hook `org-execute-file-search-functions', +which see. + +A function in this hook may also use `setq' to set the variable +`description' to provide a suggestion for the descriptive text to +be used for this link when it gets inserted into an Org buffer +with \\[org-insert-link].") + +(defvar org-execute-file-search-functions nil + "List of functions to execute a file search triggered by a link. + +Functions added to this hook must accept a single argument, the +search string that was part of the file link, the part after the +double colon. The function must first check if it would like to +handle this search, for example by checking the `major-mode' or +the file extension. If it decides not to handle this search, it +should just return nil to give other functions a chance. If it +does handle the search, it must return a non-nil value to keep +other functions from trying. + +Each function can access the current prefix argument through the +variable `current-prefix-arg'. Note that a single prefix is used +to force opening a link in Emacs, so it may be good to only use a +numeric or double prefix to guide the search function. + +In case this is needed, a function in this hook can also restore +the window configuration before `org-open-at-point' was called using: + + (set-window-configuration org-window-config-before-follow-link)") + +(defvar org-open-link-functions nil + "Hook for functions finding a plain text link. +These functions must take a single argument, the link content. +They will be called for links that look like [[link text][description]] +when LINK TEXT does not have a protocol like \"http:\" and does not look +like a filename (e.g. \"./blue.png\"). + +These functions will be called *before* Org attempts to resolve the +link by doing text searches in the current buffer - so if you want a +link \"[[target]]\" to still find \"<<target>>\", your function should +handle this as a special case. + +When the function does handle the link, it must return a non-nil value. +If it decides that it is not responsible for this link, it must return +nil to indicate that that Org can continue with other options like +exact and fuzzy text search.") + + +;;; Internal Variables + +(defconst org-link--forbidden-chars "]\t\n\r<>" + "Characters forbidden within a link, as a string.") + +(defvar org-link--history nil + "History for inserted links.") + +(defvar org-link--insert-history nil + "Minibuffer history for links inserted with `org-insert-link'.") + +(defvar org-link--search-failed nil + "Non-nil when last link search failed.") + + +;;; Internal Functions + +(defun org-link--try-special-completion (type) + "If there is completion support for link type TYPE, offer it." + (let ((fun (org-link-get-parameter type :complete))) + (if (functionp fun) + (funcall fun) + (read-string "Link (no completion support): " (concat type ":"))))) + +(defun org-link--prettify (link) + "Return a human-readable representation of LINK. +The car of LINK must be a raw link. The cdr of LINK must be +either a link description or nil." + (let ((desc (or (cadr link) "<no description>"))) + (concat (format "%-45s" (substring desc 0 (min (length desc) 40))) + "<" (car link) ">"))) + +(defun org-link--unescape-compound (hex) + "Unhexify Unicode hex-chars HEX. +E.g. \"%C3%B6\" is the German o-Umlaut. Note: this function also +decodes single byte encodings like \"%E1\" (a-acute) if not +followed by another \"%[A-F0-9]{2}\" group." + (save-match-data + (let* ((bytes (cdr (split-string hex "%"))) + (ret "") + (eat 0) + (sum 0)) + (while bytes + (let* ((val (string-to-number (pop bytes) 16)) + (shift-xor + (if (= 0 eat) + (cond + ((>= val 252) (cons 6 252)) + ((>= val 248) (cons 5 248)) + ((>= val 240) (cons 4 240)) + ((>= val 224) (cons 3 224)) + ((>= val 192) (cons 2 192)) + (t (cons 0 0))) + (cons 6 128)))) + (when (>= val 192) (setq eat (car shift-xor))) + (setq val (logxor val (cdr shift-xor))) + (setq sum (+ (lsh sum (car shift-xor)) val)) + (when (> eat 0) (setq eat (- eat 1))) + (cond + ((= 0 eat) ;multi byte + (setq ret (concat ret (char-to-string sum))) + (setq sum 0)) + ((not bytes) ; single byte(s) + (setq ret (org-link--unescape-single-byte-sequence hex)))))) + ret))) + +(defun org-link--unescape-single-byte-sequence (hex) + "Unhexify hex-encoded single byte character sequence HEX." + (mapconcat (lambda (byte) + (char-to-string (string-to-number byte 16))) + (cdr (split-string hex "%")) "")) + +(defun org-link--fontify-links-to-this-file () + "Fontify links to the current file in `org-stored-links'." + (let ((f (buffer-file-name)) a b) + (setq a (mapcar (lambda(l) + (let ((ll (car l))) + (when (and (string-match "^file:\\(.+\\)::" ll) + (equal f (expand-file-name (match-string 1 ll)))) + ll))) + org-stored-links)) + (when (featurep 'org-id) + (setq b (mapcar (lambda(l) + (let ((ll (car l))) + (when (and (string-match "^id:\\(.+\\)$" ll) + (equal f (expand-file-name + (or (org-id-find-id-file + (match-string 1 ll)) "")))) + ll))) + org-stored-links))) + (mapcar (lambda(l) + (put-text-property 0 (length l) 'face 'font-lock-comment-face l)) + (delq nil (append a b))))) + +(defun org-link--buffer-for-internals () + "Return buffer used for displaying the target of internal links." + (cond + ((not org-link-use-indirect-buffer-for-internals) (current-buffer)) + ((string-suffix-p "(Clone)" (buffer-name)) + (message "Buffer is already a clone, not making another one") + ;; We also do not modify visibility in this case. + (current-buffer)) + (t ;make a new indirect buffer for displaying the link + (let* ((indirect-buffer-name (concat (buffer-name) "(Clone)")) + (indirect-buffer + (or (get-buffer indirect-buffer-name) + (make-indirect-buffer (current-buffer) + indirect-buffer-name + 'clone)))) + (with-current-buffer indirect-buffer (org-overview)) + indirect-buffer)))) + +(defun org-link--search-radio-target (target) + "Search a radio target matching TARGET in current buffer. +White spaces are not significant." + (let ((re (format "<<<%s>>>" + (mapconcat #'regexp-quote + (split-string target) + "[ \t]+\\(?:\n[ \t]*\\)?"))) + (origin (point))) + (goto-char (point-min)) + (catch :radio-match + (while (re-search-forward re nil t) + (forward-char -1) + (let ((object (org-element-context))) + (when (eq (org-element-type object) 'radio-target) + (goto-char (org-element-property :begin object)) + (org-show-context 'link-search) + (throw :radio-match nil)))) + (goto-char origin) + (user-error "No match for radio target: %s" target)))) + + +;;; Public API + +(defun org-link-types () + "Return a list of known link types." + (mapcar #'car org-link-parameters)) + +(defun org-link-get-parameter (type key) + "Get TYPE link property for KEY. +TYPE is a string and KEY is a plist keyword. See +`org-link-parameters' for supported keywords." + (plist-get (cdr (assoc type org-link-parameters)) + key)) + +(defun org-link-set-parameters (type &rest parameters) + "Set link TYPE properties to PARAMETERS. +PARAMETERS should be keyword value pairs. See +`org-link-parameters' for supported keys." + (let ((data (assoc type org-link-parameters))) + (if data (setcdr data (org-combine-plists (cdr data) parameters)) + (push (cons type parameters) org-link-parameters) + (org-link-make-regexps) + (when (featurep 'org-element) (org-element-update-syntax))))) + +(defun org-link-make-regexps () + "Update the link regular expressions. +This should be called after the variable `org-link-parameters' has changed." + (let ((types-re (regexp-opt (org-link-types) t))) + (setq org-link-types-re + (concat "\\`" types-re ":") + org-link-re-with-space + (concat "<?" types-re ":" + "\\([^" org-link--forbidden-chars " ]" + "[^" org-link--forbidden-chars "]*" + "[^" org-link--forbidden-chars " ]\\)>?") + org-link-re-with-space2 + (concat "<?" types-re ":" + "\\([^" org-link--forbidden-chars " ]" + "[^\t\n\r]*" + "[^" org-link--forbidden-chars " ]\\)>?") + org-link-re-with-space3 + (concat "<?" types-re ":" + "\\([^" org-link--forbidden-chars " ]" + "[^\t\n\r]*\\)") + org-link-angle-re + (format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>" + types-re) + org-link-plain-re + (concat + "\\<" types-re ":" + "\\([^][ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)") + ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") + org-link-bracket-re + "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" + org-link-analytic-bracket-re + (concat + "\\[\\[" + "\\(" types-re ":\\)?" + "\\([^]]+\\)" + "\\]" + "\\(\\[" "\\([^]]+\\)" "\\]\\)?" + "\\]") + org-link-any-re + (concat "\\(" org-link-bracket-re "\\)\\|\\(" + org-link-angle-re "\\)\\|\\(" + org-link-plain-re "\\)")))) + +(defun org-link-complete-file (&optional arg) + "Create a file link using completion." + (let ((file (read-file-name "File: ")) + (pwd (file-name-as-directory (expand-file-name "."))) + (pwd1 (file-name-as-directory (abbreviate-file-name + (expand-file-name "."))))) + (cond ((equal arg '(16)) + (concat "file:" + (abbreviate-file-name (expand-file-name file)))) + ((string-match + (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) + (concat "file:" (match-string 1 file))) + ((string-match + (concat "^" (regexp-quote pwd) "\\(.+\\)") + (expand-file-name file)) + (concat "file:" + (match-string 1 (expand-file-name file)))) + (t (concat "file:" file))))) + +(defun org-link-email-description (&optional fmt) + "Return the description part of an email link. +This takes information from `org-store-link-plist' and formats it +according to FMT (default from `org-link-email-description-format')." + (setq fmt (or fmt org-link-email-description-format)) + (let* ((p org-store-link-plist) + (to (plist-get p :toaddress)) + (from (plist-get p :fromaddress)) + (table + (list + (cons "%c" (plist-get p :fromto)) + (cons "%F" (plist-get p :from)) + (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?")) + (cons "%T" (plist-get p :to)) + (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?")) + (cons "%s" (plist-get p :subject)) + (cons "%d" (plist-get p :date)) + (cons "%m" (plist-get p :message-id))))) + (when (string-match "%c" fmt) + ;; Check if the user wrote this message + (if (and org-link-from-user-regexp from to + (save-match-data (string-match org-link-from-user-regexp from))) + (setq fmt (replace-match "to %t" t t fmt)) + (setq fmt (replace-match "from %f" t t fmt)))) + (org-replace-escapes fmt table))) + +(defun org-link-store-props (&rest plist) + "Store link properties. +The properties are pre-processed by extracting names, addresses +and dates." + (let ((x (plist-get plist :from))) + (when x + (let ((adr (mail-extract-address-components x))) + (setq plist (plist-put plist :fromname (car adr))) + (setq plist (plist-put plist :fromaddress (nth 1 adr)))))) + (let ((x (plist-get plist :to))) + (when x + (let ((adr (mail-extract-address-components x))) + (setq plist (plist-put plist :toname (car adr))) + (setq plist (plist-put plist :toaddress (nth 1 adr)))))) + (let ((x (ignore-errors (date-to-time (plist-get plist :date))))) + (when x + (setq plist (plist-put plist :date-timestamp + (format-time-string + (org-time-stamp-format t) x))) + (setq plist (plist-put plist :date-timestamp-inactive + (format-time-string + (org-time-stamp-format t t) x))))) + (let ((from (plist-get plist :from)) + (to (plist-get plist :to))) + (when (and from to org-link-from-user-regexp) + (setq plist + (plist-put plist :fromto + (if (string-match org-link-from-user-regexp from) + (concat "to %t") + (concat "from %f")))))) + (setq org-store-link-plist plist)) + +(defun org-link-add-props (&rest plist) + "Add these properties to the link property list." + (let (key value) + (while plist + (setq key (pop plist) value (pop plist)) + (setq org-store-link-plist + (plist-put org-store-link-plist key value))))) + +(defun org-link-escape (text &optional table merge) + "Return percent escaped representation of TEXT. +TEXT is a string with the text to escape. +Optional argument TABLE is a list with characters that should be +escaped. When nil, `org-link-escape-chars' is used. +If optional argument MERGE is set, merge TABLE into +`org-link-escape-chars'." + (let ((characters-to-encode + (cond ((null table) org-link-escape-chars) + (merge (append org-link-escape-chars table)) + (t table)))) + (mapconcat + (lambda (c) + (if (or (memq c characters-to-encode) + (and org-link-url-hexify (or (< c 32) (> c 126)))) + (mapconcat (lambda (e) (format "%%%.2X" e)) + (or (encode-coding-char c 'utf-8) + (error "Unable to percent escape character: %c" c)) + "") + (char-to-string c))) + text ""))) + +(defun org-link-unescape (str) + "Unhex hexified Unicode parts in string STR. +E.g. \"%C3%B6\" becomes the german o-Umlaut. This is the +reciprocal of `org-link-escape', which see." + (if (org-string-nw-p str) + (replace-regexp-in-string + "\\(%[0-9A-Za-z]\\{2\\}\\)+" #'org-link--unescape-compound str t t) + str)) + +(defun org-link-make-string (link &optional description) + "Make a bracket link, consisting of LINK and DESCRIPTION." + (unless (org-string-nw-p link) (error "Empty link")) + (let ((uri (cond ((string-match org-link-types-re link) + (concat (match-string 1 link) + (org-link-escape (substring link (match-end 1))))) + ((or (file-name-absolute-p link) + (string-match-p "\\`\\.\\.?/" link)) + (org-link-escape link)) + ;; For readability, do not encode space characters + ;; in fuzzy links. + (t (org-link-escape link (remq ?\s org-link-escape-chars))))) + (description + (and (org-string-nw-p description) + ;; Remove brackets from description, as they are fatal. + (replace-regexp-in-string + "[][]" (lambda (m) (if (equal "[" m) "{" "}")) + (org-trim description))))) + (format "[[%s]%s]" + uri + (if description (format "[%s]" description) "")))) + +(defun org-store-link-functions () + "List of functions that are called to create and store a link. + +The functions are defined in the `:store' property of +`org-link-parameters'. + +Each function will be called in turn until one returns a non-nil +value. Each function should check if it is responsible for +creating this link (for example by looking at the major mode). +If not, it must exit and return nil. If yes, it should return +a non-nil value after calling `org-link-store-props' with a list +of properties and values. Special properties are: + +:type The link prefix, like \"http\". This must be given. +:link The link, like \"http://www.astro.uva.nl/~dominik\". + This is obligatory as well. +:description Optional default description for the second pair + of brackets in an Org mode link. The user can still change + this when inserting this link into an Org mode buffer. + +In addition to these, any additional properties can be specified +and then used in capture templates." + (cl-loop for link in org-link-parameters + with store-func + do (setq store-func (org-link-get-parameter (car link) :store)) + if store-func + collect store-func)) + +(defun org-link-expand-abbrev (link) + "Replace link abbreviations in LINK string. +Abbreviations are defined in `org-link-abbrev-alist'." + (if (not (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link)) link + (let* ((key (match-string 1 link)) + (as (or (assoc key org-link-abbrev-alist-local) + (assoc key org-link-abbrev-alist))) + (tag (and (match-end 2) (match-string 3 link))) + rpl) + (if (not as) + link + (setq rpl (cdr as)) + (cond + ((symbolp rpl) (funcall rpl tag)) + ((string-match "%(\\([^)]+\\))" rpl) + (replace-match + (save-match-data + (funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl)) + ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) + ((string-match "%h" rpl) + (replace-match (url-hexify-string (or tag "")) t t rpl)) + (t (concat rpl tag))))))) + +(defun org-link-open (link &optional arg) + "Open a link object LINK. +Optional argument is passed to `org-open-file' when S is +a \"file\" link." + (let ((type (org-element-property :type link)) + (path (org-element-property :path link))) + (cond + ((equal type "file") + (if (string-match "[*?{]" (file-name-nondirectory path)) + (dired path) + ;; Look into `org-link-parameters' in order to find + ;; a DEDICATED-FUNCTION to open file. The function will be + ;; applied on raw link instead of parsed link due to the + ;; limitation in `org-add-link-type' ("open" function called + ;; with a single argument). If no such function is found, + ;; fallback to `org-open-file'. + (let* ((option (org-element-property :search-option link)) + (app (org-element-property :application link)) + (dedicated-function + (org-link-get-parameter (if app (concat type "+" app) type) + :follow))) + (if dedicated-function + (funcall dedicated-function + (concat path + (and option (concat "::" option)))) + (apply #'org-open-file + path + (cond (arg) + ((equal app "emacs") 'emacs) + ((equal app "sys") 'system)) + (cond ((not option) nil) + ((string-match-p "\\`[0-9]+\\'" option) + (list (string-to-number option))) + (t (list nil option)))))))) + ((functionp (org-link-get-parameter type :follow)) + (funcall (org-link-get-parameter type :follow) path)) + ((member type '("coderef" "custom-id" "fuzzy" "radio")) + (unless (run-hook-with-args-until-success 'org-open-link-functions path) + (if (not arg) (org-mark-ring-push) + (switch-to-buffer-other-window (org-link--buffer-for-internals))) + (let ((destination + (org-with-wide-buffer + (if (equal type "radio") + (org-link--search-radio-target + (org-element-property :path link)) + (org-link-search + (pcase type + ("custom-id" (concat "#" path)) + ("coderef" (format "(%s)" path)) + (_ path)) + ;; Prevent fuzzy links from matching themselves. + (and (equal type "fuzzy") + (+ 2 (org-element-property :begin link))))) + (point)))) + (unless (and (<= (point-min) destination) + (>= (point-max) destination)) + (widen)) + (goto-char destination)))) + (t (browse-url-at-point))))) + +(defun org-link-open-from-string (s &optional arg) + "Open a link in the string S, as if it was in Org mode. +Optional argument is passed to `org-open-file' when S is +a \"file\" link." + (interactive "sLink: \nP") + (pcase (with-temp-buffer + (let ((org-inhibit-startup nil)) + (insert s) + (org-mode) + (goto-char (point-min)) + (org-element-link-parser))) + (`nil (user-error "No valid link in %S" s)) + (link (org-link-open link arg)))) + +(defun org-link-search (s &optional avoid-pos stealth) + "Search for a search string S. + +If S starts with \"#\", it triggers a custom ID search. + +If S is enclosed within parenthesis, it initiates a coderef +search. + +If S is surrounded by forward slashes, it is interpreted as +a regular expression. In Org mode files, this will create an +`org-occur' sparse tree. In ordinary files, `occur' will be used +to list matches. If the current buffer is in `dired-mode', grep +will be used to search in all files. + +When AVOID-POS is given, ignore matches near that position. + +When optional argument STEALTH is non-nil, do not modify +visibility around point, thus ignoring `org-show-context-detail' +variable. + +Search is case-insensitive and ignores white spaces. Return type +of matched result, which is either `dedicated' or `fuzzy'." + (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s)) + (let* ((case-fold-search t) + (origin (point)) + (normalized (replace-regexp-in-string "\n[ \t]*" " " s)) + (starred (eq (string-to-char normalized) ?*)) + (words (split-string (if starred (substring s 1) s))) + (s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)")) + (s-single-re (mapconcat #'regexp-quote words "[ \t]+")) + type) + (cond + ;; Check if there are any special search functions. + ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) + ((eq (string-to-char s) ?#) + ;; Look for a custom ID S if S starts with "#". + (let* ((id (substring normalized 1)) + (match (org-find-property "CUSTOM_ID" id))) + (if match (progn (goto-char match) (setf type 'dedicated)) + (error "No match for custom ID: %s" id)))) + ((string-match "\\`(\\(.*\\))\\'" normalized) + ;; Look for coderef targets if S is enclosed within parenthesis. + (let ((coderef (match-string-no-properties 1 normalized)) + (re (substring s-single-re 1 -1))) + (goto-char (point-min)) + (catch :coderef-match + (while (re-search-forward re nil t) + (let ((element (org-element-at-point))) + (when (and (memq (org-element-type element) + '(example-block src-block)) + (org-match-line + (concat ".*?" (org-src-coderef-regexp + (org-src-coderef-format element) + coderef)))) + (setq type 'dedicated) + (goto-char (match-beginning 2)) + (throw :coderef-match nil)))) + (goto-char origin) + (error "No match for coderef: %s" coderef)))) + ((string-match "\\`/\\(.*\\)/\\'" normalized) + ;; Look for a regular expression. + (funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur) + (match-string 1 s))) + ;; From here, we handle fuzzy links. + ;; + ;; Look for targets, only if not in a headline search. + ((and (not starred) + (let ((target (format "<<%s>>" s-multi-re))) + (catch :target-match + (goto-char (point-min)) + (while (re-search-forward target nil t) + (backward-char) + (let ((context (org-element-context))) + (when (eq (org-element-type context) 'target) + (setq type 'dedicated) + (goto-char (org-element-property :begin context)) + (throw :target-match t)))) + nil)))) + ;; Look for elements named after S, only if not in a headline + ;; search. + ((and (not starred) + (let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re))) + (catch :name-match + (goto-char (point-min)) + (while (re-search-forward name nil t) + (let ((element (org-element-at-point))) + (when (equal words + (split-string + (org-element-property :name element))) + (setq type 'dedicated) + (beginning-of-line) + (throw :name-match t)))) + nil)))) + ;; Regular text search. Prefer headlines in Org mode buffers. + ;; Ignore COMMENT keyword, TODO keywords, priority cookies, + ;; statistics cookies and tags. + ((and (derived-mode-p 'org-mode) + (let ((title-re + (format "%s.*\\(?:%s[ \t]\\)?.*%s" + org-outline-regexp-bol + org-comment-string + (mapconcat #'regexp-quote words ".+"))) + (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]") + (comment-re (format "\\`%s[ \t]+" org-comment-string))) + (goto-char (point-min)) + (catch :found + (while (re-search-forward title-re nil t) + (when (equal words + (split-string + (replace-regexp-in-string + cookie-re "" + (replace-regexp-in-string + comment-re "" (org-get-heading t t t))))) + (throw :found t))) + nil))) + (beginning-of-line) + (setq type 'dedicated)) + ;; Offer to create non-existent headline depending on + ;; `org-link-search-must-match-exact-headline'. + ((and (derived-mode-p 'org-mode) + (eq org-link-search-must-match-exact-headline 'query-to-create) + (yes-or-no-p "No match - create this as a new heading? ")) + (goto-char (point-max)) + (unless (bolp) (newline)) + (org-insert-heading nil t t) + (insert s "\n") + (beginning-of-line 0)) + ;; Only headlines are looked after. No need to process + ;; further: throw an error. + ((and (derived-mode-p 'org-mode) + (or starred org-link-search-must-match-exact-headline)) + (goto-char origin) + (error "No match for fuzzy expression: %s" normalized)) + ;; Regular text search. + ((catch :fuzzy-match + (goto-char (point-min)) + (while (re-search-forward s-multi-re nil t) + ;; Skip match if it contains AVOID-POS or it is included in + ;; a link with a description but outside the description. + (unless (or (and avoid-pos + (<= (match-beginning 0) avoid-pos) + (> (match-end 0) avoid-pos)) + (and (save-match-data + (org-in-regexp org-link-bracket-re)) + (match-beginning 3) + (or (> (match-beginning 3) (point)) + (<= (match-end 3) (point))) + (org-element-lineage + (save-match-data (org-element-context)) + '(link) t))) + (goto-char (match-beginning 0)) + (setq type 'fuzzy) + (throw :fuzzy-match t))) + nil)) + ;; All failed. Throw an error. + (t (goto-char origin) + (error "No match for fuzzy expression: %s" normalized))) + ;; Disclose surroundings of match, if appropriate. + (when (and (derived-mode-p 'org-mode) (not stealth)) + (org-show-context 'link-search)) + type)) + +(defun org-link-heading-search-string (&optional string) + "Make search string for the current headline or STRING." + (let ((s (or string + (and (derived-mode-p 'org-mode) + (save-excursion + (org-back-to-heading t) + (org-element-property :raw-value + (org-element-at-point)))))) + (lines org-link-context-for-files)) + (unless string (setq s (concat "*" s))) ;Add * for headlines + (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s)) + (when (and string (integerp lines) (> lines 0)) + (let ((slines (org-split-string s "\n"))) + (when (< lines (length slines)) + (setq s (mapconcat + #'identity + (reverse (nthcdr (- (length slines) lines) + (reverse slines))) "\n"))))) + (mapconcat #'identity (split-string s) " "))) + +(defun org-link-display-format (s) + "Replace links in string S with their description. +If there is no description, use the link target." + (save-match-data + (replace-regexp-in-string + org-link-analytic-bracket-re + (lambda (m) + (if (match-end 5) (match-string 5 m) + (concat (match-string 1 m) (match-string 3 m)))) + s nil t))) + +(defun org-link-add-angle-brackets (s) + "Wrap string S within angle brackets." + (unless (equal (substring s 0 1) "<") (setq s (concat "<" s))) + (unless (equal (substring s -1) ">") (setq s (concat s ">"))) + s) + + +;;; Built-in link types + +;;;; "doi" link type +(defun org-link--open-doi (path) + "Open a \"doi\" type link. +PATH is a the path to search for, as a string." + (browse-url (url-encode-url (concat org-link-doi-server-url path)))) + +(org-link-set-parameters "doi" :follow #'org-link--open-doi) + +;;;; "elisp" link type +(defun org-link--open-elisp (path) + "Open a \"elisp\" type link. +PATH is the sexp to evaluate, as a string." + (if (or (and (org-string-nw-p org-link-elisp-skip-confirm-regexp) + (string-match-p org-link-elisp-skip-confirm-regexp path)) + (not org-link-elisp-confirm-function) + (funcall org-link-elisp-confirm-function + (format "Execute %S as Elisp? " + (org-add-props path nil 'face 'org-warning)))) + (message "%s => %s" path + (if (eq ?\( (string-to-char path)) + (eval (read path)) + (call-interactively (read path)))) + (user-error "Abort"))) + +(org-link-set-parameters "elisp" :follow #'org-link--open-elisp) + +;;;; "file" link type +(org-link-set-parameters "file" :complete #'org-link-complete-file) + +;;;; "help" link type +(defun org-link--open-help (path) + "Open a \"help\" type link. +PATH is a symbol name, as a string." + (pcase (intern path) + ((and (pred fboundp) variable) (describe-function variable)) + ((and (pred boundp) function) (describe-variable function)) + (name (user-error "Unknown function or variable: %s" name)))) + +(org-link-set-parameters "help" :follow #'org-link--open-elisp) + +;;;; "http", "https", "mailto", "ftp", and "news" link types +(dolist (scheme '("ftp" "http" "https" "mailto" "news")) + (org-link-set-parameters scheme + :follow + (lambda (url) (browse-url (concat scheme ":" url))))) + +;;;; "shell" link type +(defun org-link--open-shell (path) + "Open a \"shell\" type link. +PATH is the command to execute, as a string." + (if (or (and (org-string-nw-p org-link-shell-skip-confirm-regexp) + (string-match-p org-link-shell-skip-confirm-regexp path)) + (not org-link-shell-confirm-function) + (funcall org-link-shell-confirm-function + (format "Execute %S in shell? " + (org-add-props path nil 'face 'org-warning)))) + (let ((buf (generate-new-buffer "*Org Shell Output*"))) + (message "Executing %s" path) + (shell-command path buf) + (when (featurep 'midnight) + (setq clean-buffer-list-kill-buffer-names + (cons (buffer-name buf) + clean-buffer-list-kill-buffer-names)))) + (user-error "Abort"))) + +(org-link-set-parameters "shell" :follow #'org-link--open-shell) + + +;;; Interactive Functions + +;;;###autoload +(defun org-next-link (&optional search-backward) + "Move forward to the next link. +If the link is in hidden text, expose it. When SEARCH-BACKWARD +is non-nil, move backward." + (interactive) + (when (and org-link--search-failed (eq this-command last-command)) + (goto-char (point-min)) + (message "Link search wrapped back to beginning of buffer")) + (setq org-link--search-failed nil) + (let* ((pos (point)) + (ct (org-context)) + (a (assq :link ct)) + (srch-fun (if search-backward 're-search-backward 're-search-forward))) + (cond (a (goto-char (nth (if search-backward 1 2) a))) + ((looking-at org-link-any-re) + ;; Don't stay stuck at link without an org-link face + (forward-char (if search-backward -1 1)))) + (if (funcall srch-fun org-link-any-re nil t) + (progn + (goto-char (match-beginning 0)) + (when (org-invisible-p) (org-show-context))) + (goto-char pos) + (setq org-link--search-failed t) + (message "No further link found")))) + +;;;###autoload +(defun org-previous-link () + "Move backward to the previous link. +If the link is in hidden text, expose it." + (interactive) + (org-next-link t)) + +;;;###autoload +(defun org-toggle-link-display () + "Toggle the literal or descriptive display of links." + (interactive) + (if org-link-descriptive (remove-from-invisibility-spec '(org-link)) + (add-to-invisibility-spec '(org-link))) + (org-restart-font-lock) + (setq org-link-descriptive (not org-link-descriptive))) + +;;;###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 description search txt custom-id agenda-link) + (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 + "Which function for creating the link? " + (mapcar #'car results-alist) + nil t (symbol-name name)) + results-alist))) + t)))) + (setq link (plist-get org-store-link-plist :link)) + (setq desc (or (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 'help-mode) + (setq link (concat "help:" (save-excursion + (goto-char (point-min)) + (looking-at "^[^ ]+") + (match-string 0)))) + (org-link-store-props :type "help")) + + ((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 description link))) + + ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) + (org-with-limited-levels + (setq custom-id (org-entry-get nil "CUSTOM_ID")) + (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)) + ((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")))) + ;; Store a link using the ID at point + (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))) + (setq txt (cond + ((org-at-heading-p) nil) + (name) + ((org-region-active-p) + (buffer-substring (region-beginning) (region-end))))) + (when (or (null txt) (string-match "\\S-" txt)) + (setq cpltxt + (concat cpltxt "::" + (condition-case nil + (org-link-heading-search-string txt) + (error ""))) + desc (or name + (nth 4 (ignore-errors (org-heading-components))) + "NONE"))))) + (when (string-match "::\\'" cpltxt) + (setq cpltxt (substring cpltxt 0 -2))) + (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 string. + (when (org-xor org-link-context-for-files (equal arg '(4))) + (setq txt (if (org-region-active-p) + (buffer-substring (region-beginning) (region-end)) + (buffer-substring (point-at-bol) (point-at-eol)))) + ;; Only use search option if there is some text. + (when (string-match "\\S-" txt) + (setq cpltxt + (concat cpltxt "::" (org-link-heading-search-string txt)) + 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 + (replace-regexp-in-string + org-link-analytic-bracket-re + (lambda (m) (or (match-string 5 m) (match-string 3 m))) + desc)))) + ;; Return the link + (if (not (and interactive? link)) + (or agenda-link (and link (org-link-make-string link desc))) + (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)) "::#" custom-id)) + (push (list link desc) org-stored-links)) + (car org-stored-links))))) + +;;;###autoload +(defun org-insert-link (&optional complete-file link-location description) + "Insert a link. At the prompt, enter the link. + +Completion can be used to insert any of the link protocol prefixes in use. + +The history can be used to select a link previously stored with +`org-store-link'. When the empty string is entered (i.e. if you just +press `RET' at the prompt), the link defaults to the most recently +stored link. As `SPC' triggers completion in the minibuffer, you need to +use `M-SPC' or `C-q SPC' to force the insertion of a space character. + +You will also be prompted for a description, and if one is given, it will +be displayed in the buffer instead of the link. + +If there is already a link at point, this command will allow you to edit +link and description parts. + +With a `\\[universal-argument]' prefix, prompts for a file to link to. The \ +file name can be +selected using completion. The path to the file will be relative to the +current directory if the file is in the current directory or a subdirectory. +Otherwise, the link will be the absolute path as completed in the minibuffer +\(i.e. normally ~/path/to/file). You can configure this behavior using the +option `org-link-file-path-type'. + +With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \ +absolute path even if the file is in +the current directory or below. + +A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ +prefix negates `org-link-keep-stored-after-insertion'. + +If the LINK-LOCATION parameter is non-nil, this value will be used as +the link location instead of reading one interactively. + +If the DESCRIPTION parameter is non-nil, this value will be used as the +default description. Otherwise, if `org-link-make-description-function' +is non-nil, this function will be called with the link target, and the +result will be the default link description. When called non-interactively, +don't allow to edit the default description." + (interactive "P") + (let* ((wcf (current-window-configuration)) + (origbuf (current-buffer)) + (region (when (org-region-active-p) + (buffer-substring (region-beginning) (region-end)))) + (remove (and region (list (region-beginning) (region-end)))) + (desc region) + (link link-location) + (abbrevs org-link-abbrev-alist-local) + entry all-prefixes auto-desc) + (cond + (link-location) ; specified by arg, just use it. + ((org-in-regexp org-link-bracket-re 1) + ;; We do have a link at point, and we are going to edit it. + (setq remove (list (match-beginning 0) (match-end 0))) + (setq desc (when (match-end 3) (match-string-no-properties 3))) + (setq link (read-string "Link: " + (org-link-unescape + (match-string-no-properties 1))))) + ((or (org-in-regexp org-link-angle-re) + (org-in-regexp org-link-plain-re)) + ;; Convert to bracket link + (setq remove (list (match-beginning 0) (match-end 0)) + link (read-string "Link: " + (org-unbracket-string "<" ">" (match-string 0))))) + ((member complete-file '((4) (16))) + ;; Completing read for file names. + (setq link (org-link-complete-file complete-file))) + (t + ;; Read link, with completion for stored links. + (org-link--fontify-links-to-this-file) + (org-switch-to-buffer-other-window "*Org Links*") + (with-current-buffer "*Org Links*" + (erase-buffer) + (insert "Insert a link. +Use TAB to complete link prefixes, then RET for type-specific completion support\n") + (when org-stored-links + (insert "\nStored links are available with <up>/<down> or M-p/n \ +\(most recent with RET):\n\n") + (insert (mapconcat #'org-link--prettify + (reverse org-stored-links) + "\n"))) + (goto-char (point-min))) + (let ((cw (selected-window))) + (select-window (get-buffer-window "*Org Links*" 'visible)) + (with-current-buffer "*Org Links*" (setq truncate-lines t)) + (unless (pos-visible-in-window-p (point-max)) + (org-fit-window-to-buffer)) + (and (window-live-p cw) (select-window cw))) + (setq all-prefixes (append (mapcar #'car abbrevs) + (mapcar #'car org-link-abbrev-alist) + (org-link-types))) + (unwind-protect + ;; Fake a link history, containing the stored links. + (let ((org-link--history + (append (mapcar #'car org-stored-links) + org-link--insert-history))) + (setq link + (org-completing-read + "Link: " + (append + (mapcar (lambda (x) (concat x ":")) all-prefixes) + (mapcar #'car org-stored-links)) + nil nil nil + 'org-link--history + (caar org-stored-links))) + (unless (org-string-nw-p link) (user-error "No link selected")) + (dolist (l org-stored-links) + (when (equal link (cadr l)) + (setq link (car l)) + (setq auto-desc t))) + (when (or (member link all-prefixes) + (and (equal ":" (substring link -1)) + (member (substring link 0 -1) all-prefixes) + (setq link (substring link 0 -1)))) + (setq link (with-current-buffer origbuf + (org-link--try-special-completion link))))) + (set-window-configuration wcf) + (kill-buffer "*Org Links*")) + (setq entry (assoc link org-stored-links)) + (or entry (push link org-link--insert-history)) + (setq desc (or desc (nth 1 entry))))) + + (when (funcall (if (equal complete-file '(64)) 'not 'identity) + (not org-link-keep-stored-after-insertion)) + (setq org-stored-links (delq (assoc link org-stored-links) + org-stored-links))) + + (when (and (string-match org-link-plain-re link) + (not (string-match org-ts-regexp link))) + ;; URL-like link, normalize the use of angular brackets. + (setq link (org-unbracket-string "<" ">" link))) + + ;; Check if we are linking to the current file with a search + ;; option If yes, simplify the link by using only the search + ;; option. + (when (and buffer-file-name + (let ((case-fold-search nil)) + (string-match "\\`file:\\(.+?\\)::" link))) + (let ((path (match-string-no-properties 1 link)) + (search (substring-no-properties link (match-end 0)))) + (save-match-data + (when (equal (file-truename buffer-file-name) (file-truename path)) + ;; We are linking to this same file, with a search option + (setq link search))))) + + ;; Check if we can/should use a relative path. If yes, simplify + ;; the link. + (let ((case-fold-search nil)) + (when (string-match "\\`\\(file\\|docview\\):" link) + (let* ((type (match-string-no-properties 0 link)) + (path-start (match-end 0)) + (search (and (string-match "::\\(.*\\)\\'" link) + (match-string 1 link))) + (path + (if search + (substring-no-properties + link path-start (match-beginning 0)) + (substring-no-properties link (match-end 0)))) + (origpath path)) + (cond + ((or (eq org-link-file-path-type 'absolute) + (equal complete-file '(16))) + (setq path (abbreviate-file-name (expand-file-name path)))) + ((eq org-link-file-path-type 'noabbrev) + (setq path (expand-file-name path))) + ((eq org-link-file-path-type 'relative) + (setq path (file-relative-name path))) + (t + (save-match-data + (if (string-match (concat "^" (regexp-quote + (expand-file-name + (file-name-as-directory + default-directory)))) + (expand-file-name path)) + ;; We are linking a file with relative path name. + (setq path (substring (expand-file-name path) + (match-end 0))) + (setq path (abbreviate-file-name (expand-file-name path))))))) + (setq link (concat type path (and search (concat "::" search)))) + (when (equal desc origpath) + (setq desc path))))) + + (unless auto-desc + (let ((initial-input + (cond + (description) + ((not org-link-make-description-function) desc) + (t (condition-case nil + (funcall org-link-make-description-function link desc) + (error + (message "Can't get link description from %S" + (symbol-name org-link-make-description-function)) + (sit-for 2) + nil)))))) + (setq desc (if (called-interactively-p 'any) + (read-string "Description: " initial-input) + initial-input)))) + + (unless (org-string-nw-p desc) (setq desc nil)) + (when remove (apply #'delete-region remove)) + (insert (org-link-make-string link desc)) + ;; Redisplay so as the new link has proper invisible characters. + (sit-for 0))) + +;;;###autoload +(defun org-insert-all-links (arg &optional pre post) + "Insert all links in `org-stored-links'. +When a universal prefix, do not delete the links from `org-stored-links'. +When `ARG' is a number, insert the last N link(s). +`PRE' and `POST' are optional arguments to define a string to +prepend or to append." + (interactive "P") + (let ((org-link-keep-stored-after-insertion (equal arg '(4))) + (links (copy-sequence org-stored-links)) + (pr (or pre "- ")) + (po (or post "\n")) + (cnt 1) l) + (if (null org-stored-links) + (message "No link to insert") + (while (and (or (listp arg) (>= arg cnt)) + (setq l (if (listp arg) + (pop links) + (pop org-stored-links)))) + (setq cnt (1+ cnt)) + (insert pr) + (org-insert-link nil (car l) (or (cadr l) "<no description>")) + (insert po))))) + +;;;###autoload +(defun org-insert-last-stored-link (arg) + "Insert the last link stored in `org-stored-links'." + (interactive "p") + (org-insert-all-links arg "" "\n")) + +;;;###autoload +(defun org-insert-link-global () + "Insert a link like Org mode does. +This command can be called in any mode to insert a link in Org syntax." + (interactive) + (org-load-modules-maybe) + (org-run-like-in-org-mode 'org-insert-link)) + +;;;###autoload +(defun org-update-radio-target-regexp () + "Find all radio targets in this file and update the regular expression. +Also refresh fontification if needed." + (interactive) + (let ((old-regexp org-target-link-regexp) + ;; Some languages, e.g., Chinese, do not use spaces to + ;; separate words. Also allow to surround radio targets with + ;; line-breakable characters. + (before-re "\\(?:^\\|[^[:alnum:]]\\|\\c|\\)\\(") + (after-re "\\)\\(?:$\\|[^[:alnum:]]\\|\\c|\\)") + (targets + (org-with-wide-buffer + (goto-char (point-min)) + (let (rtn) + (while (re-search-forward org-radio-target-regexp nil t) + ;; Make sure point is really within the object. + (backward-char) + (let ((obj (org-element-context))) + (when (eq (org-element-type obj) 'radio-target) + (cl-pushnew (org-element-property :value obj) rtn + :test #'equal)))) + rtn)))) + (setq org-target-link-regexp + (and targets + (concat before-re + (mapconcat + (lambda (x) + (replace-regexp-in-string + " +" "\\s-+" (regexp-quote x) t t)) + targets + "\\|") + after-re))) + (unless (equal old-regexp org-target-link-regexp) + ;; Clean-up cache. + (let ((regexp (cond ((not old-regexp) org-target-link-regexp) + ((not org-target-link-regexp) old-regexp) + (t + (concat before-re + (mapconcat + (lambda (re) + (substring re (length before-re) + (- (length after-re)))) + (list old-regexp org-target-link-regexp) + "\\|") + after-re))))) + (when (featurep 'org-element) + (org-with-point-at 1 + (while (re-search-forward regexp nil t) + (org-element-cache-refresh (match-beginning 1)))))) + ;; Re fontify buffer. + (when (memq 'radio org-highlight-links) + (org-restart-font-lock))))) + + +;;; Initialize Regexps + +(org-link-make-regexps) + + +(provide 'ol) + +;;; ol.el ends here diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 1f7eda1..d362ae2 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -46,6 +46,7 @@ ;;; Code: (require 'cl-lib) +(require 'ol) (require 'org) (require 'org-macs) @@ -3537,7 +3538,7 @@ removed from the entry content. Currently only `planning' is allowed here." (add-text-properties (match-beginning 0) (match-end 0) '(face org-link)))) (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp (point-max) t) + (while (re-search-forward org-link-bracket-re (point-max) t) (set-text-properties (match-beginning 0) (match-end 0) nil)) (goto-char (point-min)) @@ -5200,7 +5201,7 @@ function from a program - use `org-agenda-get-day-entries' instead." (when results (setq results (mapcar (lambda (i) (replace-regexp-in-string - org-bracket-link-regexp "\\3" i)) results)) + org-link-bracket-re "\\3" i)) results)) (concat (org-agenda-finalize-entries results) "\n")))) ;;; Agenda entry finders @@ -6568,7 +6569,7 @@ Any match of REMOVE-RE will be removed from TXT." extra (or (and (not habitp) extra) "") category (if (symbolp category) (symbol-name category) category) level (or level "")) - (if (string-match org-bracket-link-regexp category) + (if (string-match org-link-bracket-re category) (progn (setq l (if (match-end 3) (- (match-end 3) (match-beginning 3)) @@ -8629,9 +8630,9 @@ It also looks at the text of the entry itself." ((and buffer lk) (mapcar (lambda(l) (with-current-buffer buffer - (setq trg (and (string-match org-bracket-link-regexp l) + (setq trg (and (string-match org-link-bracket-re l) (match-string 1 l))) - (if (or (not trg) (string-match org-any-link-re trg)) + (if (or (not trg) (string-match org-link-any-re trg)) (org-with-wide-buffer (goto-char marker) (when (search-forward l nil lkend) @@ -8645,11 +8646,11 @@ It also looks at the text of the entry itself." (goto-char (match-beginning 0)) (org-open-at-point))))) lk)) - ((or (org-in-regexp (concat "\\(" org-bracket-link-regexp "\\)")) + ((or (org-in-regexp (concat "\\(" org-link-bracket-re "\\)")) (save-excursion (beginning-of-line 1) - (looking-at (concat ".*?\\(" org-bracket-link-regexp "\\)")))) - (org-open-link-from-string (match-string 1))) + (looking-at (concat ".*?\\(" org-link-bracket-re "\\)")))) + (org-link-open-from-string (match-string 1))) (t (message "No link to open here"))))) (defun org-agenda-copy-local-variable (var) @@ -8667,8 +8668,8 @@ displayed Org file fills the frame." (interactive) (if (and org-return-follows-link (not (org-get-at-bol 'org-marker)) - (org-in-regexp org-bracket-link-regexp)) - (org-open-link-from-string (match-string 0)) + (org-in-regexp org-link-bracket-re)) + (org-link-open-from-string (match-string 0)) (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) (buffer (marker-buffer marker)) @@ -10237,7 +10238,7 @@ to override `appt-message-warning-time'." (lambda (x) (let* ((evt (org-trim (replace-regexp-in-string - org-bracket-link-regexp "\\3" + org-link-bracket-re "\\3" (or (get-text-property 1 'txt x) "")))) (cat (get-text-property (1- (length x)) 'org-category x)) (tod (get-text-property 1 'time-of-day x)) diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el index c1f7973..7b7de64 100644 --- a/lisp/org-bbdb.el +++ b/lisp/org-bbdb.el @@ -93,7 +93,7 @@ ;; ;;; Code: -(require 'org) +(require 'ol) (require 'cl-lib) ;; Declare external functions and variables @@ -230,7 +230,7 @@ date year)." (bbdb-record-getprop rec 'company) (car (bbdb-record-field rec 'organization)))) (link (concat "bbdb:" name))) - (org-store-link-props :type "bbdb" :name name :company company + (org-link-store-props :type "bbdb" :name name :company company :link link :description name) link))) diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el index 9891012..cf0c15b 100644 --- a/lisp/org-bibtex.el +++ b/lisp/org-bibtex.el @@ -107,7 +107,7 @@ ;;; Code: -(require 'org) +(require 'ol) (require 'bibtex) (require 'cl-lib) (require 'org-compat) @@ -488,7 +488,7 @@ With optional argument OPTIONAL, also prompt for optional fields." (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry))))) - (org-store-link-props + (org-link-store-props :key (cdr (assoc "=key=" entry)) :author (or (cdr (assoc "author" entry)) "[no author]") :editor (or (cdr (assoc "editor" entry)) "[no editor]") diff --git a/lisp/org-capture.el b/lisp/org-capture.el index cb5b158..3221297 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -54,7 +54,12 @@ (declare-function org-clock-update-mode-line "org-clock" (&optional refresh)) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) (declare-function org-decrypt-entry "org-crypt" ()) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-lineage "org-element" (datum &optional types with-self)) +(declare-function org-element-property "org-element" (property element)) (declare-function org-encrypt-entry "org-crypt" ()) +(declare-function org-insert-link "ol" (&optional complete-file link-location default-description)) +(declare-function org-link-make-string "ol" (link &optional description)) (declare-function org-table-analyze "org-table" ()) (declare-function org-table-current-dline "org-table" ()) (declare-function org-table-fix-formulas "org-table" (key replace &optional limit delta remove)) @@ -64,6 +69,7 @@ (defvar org-end-time-was-given) (defvar org-remember-default-headline) (defvar org-remember-templates) +(defvar org-store-link-plist) (defvar org-table-border-regexp) (defvar org-table-current-begin-pos) (defvar org-table-fix-formulas-confirm) @@ -1593,7 +1599,7 @@ The template may still contain \"%?\" for cursor positioning." (org-no-properties org-clock-heading) "")) (v-K (if (marker-buffer org-clock-marker) - (org-make-link-string + (org-link-make-string (format "%s::*%s" (buffer-file-name (marker-buffer org-clock-marker)) v-k) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index bf9053e..71f5122 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -35,14 +35,17 @@ (declare-function notifications-notify "notifications" (&rest params)) (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) +(declare-function org-link-display-format "ol" (s)) +(declare-function org-link-heading-search-string "ol" (&optional string)) +(declare-function org-link-make-string "ol" (link &optional description)) (declare-function org-table-goto-line "org-table" (n)) (declare-function org-dynamic-block-define "org" (type func)) (defvar org-frame-title-format-backup frame-title-format) (defvar org-state) +(defvar org-link-bracket-re) (defvar org-time-stamp-formats) - (defgroup org-clock nil "Options concerning clocking working time in Org mode." :tag "Org Clock" @@ -2616,7 +2619,7 @@ from the dynamic block definition." (when narrow-cut-p (setq headline (if (and (string-match - (format "\\`%s\\'" org-bracket-link-regexp) + (format "\\`%s\\'" org-link-bracket-re) headline) (match-end 3)) (format "[[%s][%s]]" @@ -2854,8 +2857,8 @@ PROPERTIES: The list properties specified in the `:properties' parameter (hdl (if (not link) headline (let ((search - (org-make-org-heading-search-string headline))) - (org-make-link-string + (org-link-heading-search-string headline))) + (org-link-make-string (if (not (buffer-file-name)) search (format "file:%s::%s" (buffer-file-name) search)) ;; Prune statistics cookies. Replace diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 46aa9db..bc15943 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -42,6 +42,8 @@ (declare-function org-element-restriction "org-element" (element)) (declare-function org-element-type "org-element" (element)) (declare-function org-dynamic-block-define "org" (type func)) +(declare-function org-link-display-format "ol" (s)) +(declare-function org-link-open-from-string "ol" (s &optional arg)) (defvar org-agenda-columns-add-appointments-to-effort-sum) (defvar org-agenda-columns-compute-summary-properties) @@ -763,7 +765,7 @@ around it." (defun org-columns-open-link (&optional arg) (interactive "P") (let ((value (get-char-property (point) 'org-columns-value))) - (org-open-link-from-string value arg))) + (org-link-open-from-string value arg))) ;;;###autoload (defun org-columns-get-format-and-top-level () diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 5441bc5..41da6ff 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -47,7 +47,7 @@ (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment)) (declare-function org-get-tags "org" (&optional pos local)) (declare-function org-link-display-format "org" (s)) -(declare-function org-link-set-parameters "org" (type &rest rest)) +(declare-function org-link-set-parameters "ol" (type &rest rest)) (declare-function org-log-into-drawer "org" ()) (declare-function org-make-tag-string "org" (tags)) (declare-function org-reduced-level "org" (l)) @@ -447,6 +447,87 @@ use of this function is for the stuck project list." (define-obsolete-variable-alias 'org-agenda-overriding-columns-format 'org-overriding-columns-format "Org 9.2.2") +(define-obsolete-variable-alias 'org-doi-server-url + 'org-link-doi-server-url "Org 9.3") + +(define-obsolete-variable-alias 'org-email-link-description-format + 'org-link-email-description-format "Org 9.3") + +(define-obsolete-variable-alias 'org-make-link-description-function + 'org-link-make-description-function "Org 9.3") + +(define-obsolete-variable-alias 'org-from-is-user-regexp + 'org-link-from-user-regexp "Org 9.3") + +(define-obsolete-variable-alias 'org-descriptive-links + 'org-link-descriptive "Org 9.3") + +(define-obsolete-variable-alias 'org-url-hexify-p + 'org-link-url-hexify "Org 9.3") + +(define-obsolete-variable-alias 'org-context-in-file-links + 'org-link-context-for-files "Org 9.3") + +(define-obsolete-variable-alias 'org-keep-stored-link-after-insertion + 'org-link-keep-stored-after-insertion "Org 9.3") + +(define-obsolete-variable-alias 'org-display-internal-link-with-indirect-buffer + 'org-link-use-indirect-buffer-for-internals "Org 9.3") + +(define-obsolete-variable-alias 'org-confirm-shell-link-function + 'org-link-shell-confirm-function "Org 9.3") + +(define-obsolete-variable-alias 'org-confirm-shell-link-not-regexp + 'org-link-shell-skip-confirm-regexp "Org 9.3") + +(define-obsolete-variable-alias 'org-confirm-elisp-link-function + 'org-link-elisp-confirm-function "Org 9.3") + +(define-obsolete-variable-alias 'org-confirm-elisp-link-not-regexp + 'org-link-elisp-skip-confirm-regexp "Org 9.3") + +(define-obsolete-function-alias 'org-file-complete-link + 'org-link-complete-file "Org 9.3") + +(define-obsolete-function-alias 'org-email-link-description + 'org-link-email-description "Org 9.3") + +(define-obsolete-function-alias 'org-make-link-string + 'org-link-make-string "Org 9.3") + +(define-obsolete-function-alias 'org-store-link-props + 'org-link-store-props "Org 9.3") + +(define-obsolete-function-alias 'org-add-link-props + 'org-link-add-props "Org 9.3") + +(define-obsolete-function-alias 'org-make-org-heading-search-string + 'org-link-heading-search-string "Org 9.3") + +(define-obsolete-function-alias 'org-make-link-regexps + 'org-link-make-regexps "Org 9.3") + +(define-obsolete-variable-alias 'org-angle-link-re + 'org-link-angle-re "Org 9.3") + +(define-obsolete-variable-alias 'org-plain-link-re + 'org-link-plain-re "Org 9.3") + +(define-obsolete-variable-alias 'org-bracket-link-regexp + 'org-link-bracket-re "Org 9.3") + +(define-obsolete-variable-alias 'org-bracket-link-analytic-regexp + 'org-link-analytic-bracket-re "Org 9.3") + +(define-obsolete-variable-alias 'org-any-link-re + 'org-link-any-re "Org 9.3") + +(define-obsolete-function-alias 'org-open-link-from-string + 'org-link-open-from-string "Org 9.3") + +(define-obsolete-function-alias 'org-add-angle-brackets + 'org-link-add-angle-brackets "Org 9.3") + ;; The function was made obsolete by commit 65399674d5 of 2013-02-22. ;; This make-obsolete call was added 2016-09-01. (make-obsolete 'org-capture-import-remember-templates @@ -496,7 +577,7 @@ use of this function is for the stuck project list." ;;;; Obsolete link types -(eval-after-load 'org +(eval-after-load 'ol '(progn (org-link-set-parameters "file+emacs") ;since Org 9.0 (org-link-set-parameters "file+sys"))) ;since Org 9.0 diff --git a/lisp/org-docview.el b/lisp/org-docview.el index 40b06d3..c8635af 100644 --- a/lisp/org-docview.el +++ b/lisp/org-docview.el @@ -43,7 +43,7 @@ ;;; Code: -(require 'org) +(require 'ol) (require 'doc-view) (declare-function doc-view-goto-page "doc-view" (page)) @@ -84,7 +84,7 @@ (let* ((path buffer-file-name) (page (image-mode-window-get 'page)) (link (concat "docview:" path "::" (number-to-string page)))) - (org-store-link-props + (org-link-store-props :type "docview" :link link :description path)))) @@ -93,7 +93,7 @@ "Use the existing file name completion for file. Links to get the file name, then ask the user for the page number and append it." - (concat (replace-regexp-in-string "^file:" "docview:" (org-file-complete-link)) + (concat (replace-regexp-in-string "^file:" "docview:" (org-link-complete-file)) "::" (read-from-minibuffer "Page:" "1"))) diff --git a/lisp/org-element.el b/lisp/org-element.el index 0fea9b3..a21984a 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -62,6 +62,16 @@ (require 'avl-tree) (require 'cl-lib) +(declare-function org-link-expand-abbrev "ol" (link)) +(declare-function org-link-types "ol" ()) +(declare-function org-link-unescape "ol" (str)) + +(defvar org-link-translation-function) +(defvar org-link-types-re) +(defvar org-link-angle-re) +(defvar org-link-plain-re) +(defvar org-link-bracket-re) + ;;; Definitions And Rules @@ -3097,7 +3107,7 @@ Assume point is at the beginning of the link." (setq contents-begin (match-beginning 1)) (setq contents-end (match-end 1))) ;; Type 2: Standard link, i.e. [[https://orgmode.org][homepage]] - ((looking-at org-bracket-link-regexp) + ((looking-at org-link-bracket-re) (setq format 'bracket) (setq contents-begin (match-beginning 3)) (setq contents-end (match-end 3)) @@ -3147,7 +3157,7 @@ Assume point is at the beginning of the link." (setq type "fuzzy") (setq path raw-link)))) ;; Type 3: Plain link, e.g., https://orgmode.org - ((looking-at org-plain-link-re) + ((looking-at org-link-plain-re) (setq format 'plain) (setq raw-link (match-string-no-properties 0)) (setq type (match-string-no-properties 1)) @@ -3156,7 +3166,7 @@ Assume point is at the beginning of the link." ;; Type 4: Angular link, e.g., <https://orgmode.org>. Unlike to ;; bracket links, follow RFC 3986 and remove any extra ;; whitespace in URI. - ((looking-at org-angle-link-re) + ((looking-at org-link-angle-re) (setq format 'angle) (setq type (match-string-no-properties 1)) (setq link-end (match-end 0)) diff --git a/lisp/org-eshell.el b/lisp/org-eshell.el index fa9aee5..b29caef 100644 --- a/lisp/org-eshell.el +++ b/lisp/org-eshell.el @@ -23,9 +23,9 @@ ;;; Code: -(require 'org) (require 'eshell) (require 'esh-mode) +(require 'ol) (org-link-set-parameters "eshell" :follow #'org-eshell-open @@ -57,7 +57,7 @@ (when (eq major-mode 'eshell-mode) (let* ((command (concat "cd " dired-directory)) (link (concat (buffer-name) ":" command))) - (org-store-link-props + (org-link-store-props :link (concat "eshell:" link) :description command)))) diff --git a/lisp/org-eww.el b/lisp/org-eww.el index 47f02a3..c0d8334 100644 --- a/lisp/org-eww.el +++ b/lisp/org-eww.el @@ -44,7 +44,7 @@ ;;; Code: -(require 'org) +(require 'ol) (require 'cl-lib) (defvar eww-current-title) @@ -60,7 +60,7 @@ (defun org-eww-store-link () "Store a link to the url of an EWW buffer." (when (eq major-mode 'eww-mode) - (org-store-link-props + (org-link-store-props :type "eww" :link (if (< emacs-major-version 25) eww-current-url @@ -93,7 +93,7 @@ Otherwise point is not moved. Return point." (defun org-eww-copy-for-org-mode () "Copy current buffer content or active region with `org-mode' style links. This will encode `link-title' and `link-location' with -`org-make-link-string' and insert the transformed text into the +`org-link-make-string' and insert the transformed text into the kill ring, so that it can be yanked into an Org mode buffer with links working correctly. @@ -144,7 +144,7 @@ keep the structure of the Org file." (if (org-string-nw-p link-location) ;; Hint: link-location is different ;; for form-elements. - (org-make-link-string link-location link-title) + (org-link-make-string link-location link-title) link-title)))) (goto-char temp-position) ; reset point before jump next anchor (setq out-bound t))) ; for break out `while' loop diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index 4a296b1..0fe3828 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -56,7 +56,7 @@ (defvar electric-indent-mode) (defvar org-blank-before-new-entry) ; defined in org.el -(defvar org-bracket-link-regexp) ; defined in org.el +(defvar org-link-bracket-re) ; defined in org.el (defvar org-complex-heading-regexp) ; defined in org.el (defvar org-odd-levels-only) ; defined in org.el (defvar org-outline-regexp) ; defined in org.el @@ -489,7 +489,7 @@ This function is meant to be used for fontification only." (goto-char beg) (let ((linkp (save-match-data - (org-in-regexp org-bracket-link-regexp)))) + (org-in-regexp org-link-bracket-re)))) (and linkp (< (point) (cdr linkp)))))) ;; Verify point doesn't belong to a LaTeX macro. (not (org-inside-latex-macro-p)) diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el index 2cb2766..b7f3867 100644 --- a/lisp/org-gnus.el +++ b/lisp/org-gnus.el @@ -35,7 +35,7 @@ (require 'gnus-util) (require 'nnheader) (require 'nnir) -(require 'org) +(require 'ol) ;;; Declare external functions and variables @@ -104,6 +104,7 @@ If `org-store-link' was called with a prefix arg the meaning of (defun org-gnus-article-link (group newsgroups message-id x-no-archive) "Create a link to a Gnus article. + The article is specified by its MESSAGE-ID. Additional parameters are the Gnus GROUP, the NEWSGROUPS the article was posted to and the X-NO-ARCHIVE header value of that article. @@ -115,12 +116,12 @@ Otherwise create a link to the article inside Gnus. If `org-store-link' was called with a prefix arg the meaning of `org-gnus-prefer-web-links' is reversed." (if (and (org-xor current-prefix-arg org-gnus-prefer-web-links) - newsgroups ;; Make web links only for nntp groups - (not x-no-archive)) ;; and if X-No-Archive isn't set. - (format (if (string-match "gmane\\." newsgroups) + newsgroups ;make web links only for nntp groups + (not x-no-archive)) ;and if X-No-Archive isn't set + (format (if (string-match-p "gmane\\." newsgroups) "http://mid.gmane.org/%s" "http://groups.google.com/groups/search?as_umsgid=%s") - (org-fixup-message-id-for-http message-id)) + (url-encode-url message-id)) (concat "gnus:" group "#" message-id))) (defun org-gnus-store-link () @@ -129,9 +130,9 @@ If `org-store-link' was called with a prefix arg the meaning of (`gnus-group-mode (let ((group (gnus-group-group-name))) (when group - (org-store-link-props :type "gnus" :group group) + (org-link-store-props :type "gnus" :group group) (let ((description (org-gnus-group-link group))) - (org-add-link-props :link description :description description) + (org-link-add-props :link description :description description) description)))) ((or `gnus-summary-mode `gnus-article-mode) (let* ((group @@ -169,12 +170,12 @@ If `org-store-link' was called with a prefix arg the meaning of (setq to (or to (gnus-fetch-original-field "To"))) (setq newsgroups (gnus-fetch-original-field "Newsgroups")) (setq x-no-archive (gnus-fetch-original-field "x-no-archive"))) - (org-store-link-props :type "gnus" :from from :date date :subject subject + (org-link-store-props :type "gnus" :from from :date date :subject subject :message-id message-id :group group :to to) (let ((link (org-gnus-article-link group newsgroups message-id x-no-archive)) - (description (org-email-link-description))) - (org-add-link-props :link link :description description) + (description (org-link-email-description))) + (org-link-add-props :link link :description description) link))) (`message-mode (setq org-store-link-plist nil) ;reset @@ -197,11 +198,11 @@ If `org-store-link' was called with a prefix arg the meaning of (subject (mail-fetch-field "Subject")) newsgroup xarchive) ;those are always nil for gcc (unless gcc (error "Can not create link: No Gcc header found")) - (org-store-link-props :type "gnus" :from from :subject subject + (org-link-store-props :type "gnus" :from from :subject subject :message-id id :group gcc :to to) (let ((link (org-gnus-article-link gcc newsgroup id xarchive)) - (description (org-email-link-description))) - (org-add-link-props :link link :description description) + (description (org-link-email-description))) + (org-link-add-props :link link :description description) link))))))) (defun org-gnus-open-nntp (path) diff --git a/lisp/org-id.el b/lisp/org-id.el index e3265db..ec4d25d 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -71,9 +71,11 @@ ;;; Code: (require 'org) +(require 'ol) (declare-function message-make-fqdn "message" ()) (declare-function org-goto-location "org-goto" (&optional _buf help)) +(declare-function org-link-set-parameters "ol" (type &rest rest)) ;;; Customization @@ -648,7 +650,7 @@ optional argument MARKERP, return the position as a new marker." (match-string 4) (match-string 0))) link)))) - (org-store-link-props :link link :description desc :type "id") + (org-link-store-props :link link :description desc :type "id") link))) (defun org-id-open (id) diff --git a/lisp/org-info.el b/lisp/org-info.el index e21ac6b..4243dac 100644 --- a/lisp/org-info.el +++ b/lisp/org-info.el @@ -30,7 +30,7 @@ ;;; Code: -(require 'org) +(require 'ol) ;; Declare external functions and variables @@ -54,7 +54,7 @@ "#" Info-current-node)) (desc (concat (file-name-nondirectory Info-current-file) "#" Info-current-node))) - (org-store-link-props :type "info" :file Info-current-file + (org-link-store-props :type "info" :file Info-current-file :node Info-current-node :link link :desc desc) link))) diff --git a/lisp/org-irc.el b/lisp/org-irc.el index dd8fd16..e9d989f 100644 --- a/lisp/org-irc.el +++ b/lisp/org-irc.el @@ -48,7 +48,7 @@ ;;; Code: -(require 'org) +(require 'ol) (declare-function erc-buffer-filter "erc" (predicate &optional proc)) (declare-function erc-channel-p "erc" (channel)) @@ -155,7 +155,7 @@ the session itself." (parsed-line (org-irc-erc-get-line-from-log erc-line))) (if (erc-logging-enabled nil) (progn - (org-store-link-props + (org-link-store-props :type "file" :description (concat "'" (org-irc-ellipsify-description (cadr parsed-line) 20) @@ -168,7 +168,7 @@ the session itself." (link (org-irc-parse-link link-text))) (if link-text (progn - (org-store-link-props + (org-link-store-props :type "irc" :link (concat "irc:/" link-text) :description (concat "irc session `" link-text "'") diff --git a/lisp/org-lint.el b/lisp/org-lint.el index 55dab34..19f2b0f 100644 --- a/lisp/org-lint.el +++ b/lisp/org-lint.el @@ -106,10 +106,11 @@ ;;; Code: (require 'cl-lib) +(require 'ob) +(require 'ol) (require 'org-element) (require 'org-macro) (require 'ox) -(require 'ob) ;;; Checkers @@ -606,14 +607,13 @@ Use :header-args: instead" "Non-existent file argument in INCLUDE keyword") (let* ((visiting (if file (find-buffer-visiting file) (current-buffer))) - (buffer (or visiting (find-file-noselect file)))) + (buffer (or visiting (find-file-noselect file))) + (org-link-search-must-match-exact-headline t)) (unwind-protect (with-current-buffer buffer (when (and search - (not - (ignore-errors - (let ((org-link-search-inhibit-query t)) - (org-link-search search nil t))))) + (not (ignore-errors + (org-link-search search nil t)))) (list (org-element-property :post-affiliated k) (format "Invalid search part \"%s\" in INCLUDE keyword" diff --git a/lisp/org-mhe.el b/lisp/org-mhe.el index 969bff3..526a53f 100644 --- a/lisp/org-mhe.el +++ b/lisp/org-mhe.el @@ -31,7 +31,7 @@ ;;; Code: (require 'org-macs) -(require 'org) +(require 'ol) ;; Customization variables @@ -88,12 +88,12 @@ supported by MH-E." (subject (org-mhe-get-header "Subject:")) (date (org-mhe-get-header "Date:")) link desc) - (org-store-link-props :type "mh" :from from :to to :date date + (org-link-store-props :type "mh" :from from :to to :date date :subject subject :message-id message-id) - (setq desc (org-email-link-description)) + (setq desc (org-link-email-description)) (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#" (org-unbracket-string "<" ">" message-id))) - (org-add-link-props :link link :description desc) + (org-link-add-props :link link :description desc) link)))) (defun org-mhe-open (path) @@ -199,7 +199,7 @@ folders." (mh-search-choose) (if (eq mh-searcher 'pick) (progn - (setq article (org-add-angle-brackets article)) + (setq article (org-link-add-angle-brackets article)) (mh-search folder (list "--message-id" article)) (when (and org-mhe-search-all-folders (not (org-mhe-get-message-real-folder))) diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 7d2640a..1e6d357 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -35,6 +35,9 @@ (require 'org-agenda) (require 'cl-lib) +(declare-function org-link-escape "ol" (text &optional table merge)) +(declare-function org-link-unescape "ol" (str)) + (defvar org-agenda-keep-restricted-file-list) ;;; Code: diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el index 70a8173..3bfd810 100644 --- a/lisp/org-pcomplete.el +++ b/lisp/org-pcomplete.el @@ -44,7 +44,7 @@ (declare-function org-get-export-keywords "org" ()) (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment)) (declare-function org-get-tags "org" (&optional pos local)) -(declare-function org-make-org-heading-search-string "org" (&optional string)) +(declare-function org-link-heading-search-string "ol" (&optional string)) (declare-function org-tag-alist-to-string "org" (alist &optional skip-key)) (defvar org-current-tag-alist) @@ -352,8 +352,7 @@ This needs more work, to handle headings with lots of spaces in them." (goto-char (point-min)) (let (tbl) (while (re-search-forward org-outline-regexp nil t) - (push (org-make-org-heading-search-string - (org-get-heading t t t t)) + (push (org-link-heading-search-string (org-get-heading t t t t)) tbl)) (pcomplete-uniquify-list tbl))) ;; When completing a bracketed link, i.e., "[[*", argument diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el index d9fdef0..ea2873e 100644 --- a/lisp/org-protocol.el +++ b/lisp/org-protocol.el @@ -116,6 +116,7 @@ ;;; Code: (require 'org) +(require 'ol) (declare-function org-publish-get-project-from-filename "ox-publish" (filename &optional up)) @@ -489,12 +490,12 @@ Now template ?b will be used." (region (or (plist-get parts :body) "")) (orglink (if (null url) title - (org-make-link-string url (or (org-string-nw-p title) url)))) + (org-link-make-string url (or (org-string-nw-p title) url)))) ;; Avoid call to `org-store-link'. (org-capture-link-is-already-stored t)) ;; Only store link if there's a URL to insert later on. (when url (push (list url title) org-stored-links)) - (org-store-link-props :type type + (org-link-store-props :type type :link url :description title :annotation orglink diff --git a/lisp/org-rmail.el b/lisp/org-rmail.el index c3d941e..9390bdd 100644 --- a/lisp/org-rmail.el +++ b/lisp/org-rmail.el @@ -30,7 +30,7 @@ ;;; Code: -(require 'org) +(require 'ol) ;; Declare external functions and variables (declare-function rmail-show-message "rmail" (&optional n no-summary)) @@ -65,13 +65,13 @@ (subject (mail-fetch-field "subject")) (date (mail-fetch-field "date")) desc link) - (org-store-link-props + (org-link-store-props :type "rmail" :from from :to to :date date :subject subject :message-id message-id) (setq message-id (org-unbracket-string "<" ">" message-id)) - (setq desc (org-email-link-description)) + (setq desc (org-link-email-description)) (setq link (concat "rmail:" folder "#" message-id)) - (org-add-link-props :link link :description desc) + (org-link-add-props :link link :description desc) (rmail-show-message rmail-current-message) link))))) @@ -89,7 +89,7 @@ (require 'rmail) (cond ((null article) (setq article "")) ((stringp article) - (setq article (org-add-angle-brackets article))) + (setq article (org-link-add-angle-brackets article))) (t (user-error "Wrong RMAIL link format"))) (let (message-number) (save-excursion diff --git a/lisp/org-w3m.el b/lisp/org-w3m.el index 7db3473..8bde130 100644 --- a/lisp/org-w3m.el +++ b/lisp/org-w3m.el @@ -41,7 +41,7 @@ ;;; Code: -(require 'org) +(require 'ol) (defvar w3m-current-url) (defvar w3m-current-title) @@ -50,7 +50,7 @@ (defun org-w3m-store-link () "Store a link to a w3m buffer." (when (eq major-mode 'w3m-mode) - (org-store-link-props + (org-link-store-props :type "w3m" :link w3m-current-url :url (url-view-url t) @@ -59,7 +59,7 @@ (defun org-w3m-copy-for-org-mode () "Copy current buffer content or active region with Org style links. This will encode `link-title' and `link-location' with -`org-make-link-string', and insert the transformed test into the kill ring, +`org-link-make-string', and insert the transformed test into the kill ring, so that it can be yanked into an Org buffer with links working correctly." (interactive) (let* ((regionp (org-region-active-p)) @@ -98,7 +98,7 @@ so that it can be yanked into an Org buffer with links working correctly." (setq return-content (concat return-content (if (org-string-nw-p link-location) - (org-make-link-string link-location link-title) + (org-link-make-string link-location link-title) link-title)))) (goto-char temp-position) ; reset point before jump next anchor (setq out-bound t))) ; for break out `while' loop diff --git a/lisp/org.el b/lisp/org.el index 8bdc598..bb5677f 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -93,6 +93,7 @@ (eval-and-compile (require 'org-macs)) (require 'org-compat) (require 'org-keys) +(require 'ol) ;; `org-outline-regexp' ought to be a defconst but is let-bound in ;; some places -- e.g. see the macro `org-with-limited-levels'. @@ -224,13 +225,17 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-timer-stop "org-timer" ()) (declare-function org-timer-stop "org-timer" ()) (declare-function org-toggle-archive-tag "org-archive" (&optional find-done)) +(declare-function org-update-radio-target-regexp "ol" ()) (declare-function orgtbl-ascii-plot "org-table" (&optional ask)) (declare-function orgtbl-mode "org-table" (&optional arg)) (defvar ffap-url-regexp) (defvar org-element-paragraph-separate) (defvar org-indent-indentation-per-level) +(defvar org-radio-target-regexp) (defvar org-table-auto-blank-field) +(defvar org-target-link-regexp) +(defvar org-target-regexp) ;; load languages based on value of `org-babel-load-languages' (defvar org-babel-load-languages) @@ -1255,6 +1260,159 @@ new-frame Make a new frame each time. Note that in this case (const :tag "Each time a new frame" new-frame) (const :tag "One dedicated frame" dedicated-frame))) +(defconst org-file-apps-gnu + '((remote . emacs) + (system . mailcap) + (t . mailcap)) + "Default file applications on a UNIX or GNU/Linux system. +See `org-file-apps'.") + +(defconst org-file-apps-macos + '((remote . emacs) + (system . "open %s") + ("ps.gz" . "gv %s") + ("eps.gz" . "gv %s") + ("dvi" . "xdvi %s") + ("fig" . "xfig %s") + (t . "open %s")) + "Default file applications on a macOS system. +The system \"open\" is known as a default, but we use X11 applications +for some files for which the OS does not have a good default. +See `org-file-apps'.") + +(defconst org-file-apps-windowsnt + (list '(remote . emacs) + (cons 'system (lambda (file _path) + (with-no-warnings (w32-shell-execute "open" file)))) + (cons t (lambda (file _path) + (with-no-warnings (w32-shell-execute "open" file))))) + "Default file applications on a Windows NT system. +The system \"open\" is used for most files. +See `org-file-apps'.") + +(defcustom org-file-apps + '((auto-mode . emacs) + ("\\.mm\\'" . default) + ("\\.x?html?\\'" . default) + ("\\.pdf\\'" . default)) + "External applications for opening `file:path' items in a document. +\\<org-mode-map>\ + +Org mode uses system defaults for different file types, but +you can use this variable to set the application for a given file +extension. The entries in this list are cons cells where the car identifies +files and the cdr the corresponding command. + +Possible values for the file identifier are: + + \"string\" A string as a file identifier can be interpreted in different + ways, depending on its contents: + + - Alphanumeric characters only: + Match links with this file extension. + Example: (\"pdf\" . \"evince %s\") + to open PDFs with evince. + + - Regular expression: Match links where the + filename matches the regexp. If you want to + use groups here, use shy groups. + + Example: (\"\\\\.x?html\\\\\\='\" . \"firefox %s\") + (\"\\\\(?:xhtml\\\\|html\\\\)\\\\\\='\" . \"firefox %s\") + to open *.html and *.xhtml with firefox. + + - Regular expression which contains (non-shy) groups: + Match links where the whole link, including \"::\", and + anything after that, matches the regexp. + In a custom command string, %1, %2, etc. are replaced with + the parts of the link that were matched by the groups. + For backwards compatibility, if a command string is given + that does not use any of the group matches, this case is + handled identically to the second one (i.e. match against + file name only). + In a custom function, you can access the group matches with + (match-string n link). + + Example: (\"\\\\.pdf::\\\\([0-9]+\\\\)\\\\\\='\" . \ +\"evince -p %1 %s\") + to open [[file:document.pdf::5]] with evince at page 5. + + `directory' Matches a directory + `remote' Matches a remote file, accessible through tramp or efs. + Remote files most likely should be visited through Emacs + because external applications cannot handle such paths. +`auto-mode' Matches files that are matched by any entry in `auto-mode-alist', + so all files Emacs knows how to handle. Using this with + command `emacs' will open most files in Emacs. Beware that this + will also open html files inside Emacs, unless you add + (\"html\" . default) to the list as well. + `system' The system command to open files, like `open' on Windows + and macOS, and mailcap under GNU/Linux. This is the command + that will be selected if you call `org-open-at-point' with a + double prefix argument (`\\[universal-argument] \ +\\[universal-argument] \\[org-open-at-point]'). + t Default for files not matched by any of the other options. + +Possible values for the command are: + + `emacs' The file will be visited by the current Emacs process. + `default' Use the default application for this file type, which is the + association for t in the list, most likely in the system-specific + part. This can be used to overrule an unwanted setting in the + system-specific variable. + `system' Use the system command for opening files, like \"open\". + This command is specified by the entry whose car is `system'. + Most likely, the system-specific version of this variable + does define this command, but you can overrule/replace it + here. +`mailcap' Use command specified in the mailcaps. + string A command to be executed by a shell; %s will be replaced + by the path to the file. + function A Lisp function, which will be called with two arguments: + the file path and the original link string, without the + \"file:\" prefix. + +For more examples, see the system specific constants +`org-file-apps-macos' +`org-file-apps-windowsnt' +`org-file-apps-gnu'." + :group 'org + :type '(repeat + (cons (choice :value "" + (string :tag "Extension") + (const :tag "System command to open files" system) + (const :tag "Default for unrecognized files" t) + (const :tag "Remote file" remote) + (const :tag "Links to a directory" directory) + (const :tag "Any files that have Emacs modes" + auto-mode)) + (choice :value "" + (const :tag "Visit with Emacs" emacs) + (const :tag "Use default" default) + (const :tag "Use the system command" system) + (string :tag "Command") + (function :tag "Function"))))) + +(defcustom org-open-non-existing-files nil + "Non-nil means `org-open-file' opens non-existing files. + +When nil, an error is thrown. + +This variable applies only to external applications because they +might choke on non-existing files. If the link is to a file that +will be opened in Emacs, the variable is ignored." + :group 'org + :type 'boolean + :safe #'booleanp) + +(defcustom org-open-directory-means-index-dot-org nil + "When non-nil a link to a directory really means to \"index.org\". +When nil, following a directory link runs Dired or opens +a finder/explorer window on that directory." + :group 'org + :type 'boolean + :safe #'booleanp) + (defcustom org-bookmark-names-plist '(:last-capture "org-capture-last-stored" :last-refile "org-refile-last-stored" @@ -1680,148 +1838,6 @@ calls `table-recognize-table'." :group 'org-table-editing :type 'boolean) -(defgroup org-link nil - "Options concerning links in Org mode." - :tag "Org Link" - :group 'org) - -(defvar-local org-link-abbrev-alist-local nil - "Buffer-local version of `org-link-abbrev-alist', which see. -The value of this is taken from the #+LINK lines.") - -(defcustom org-link-parameters - '(("doi" :follow org--open-doi-link) - ("elisp" :follow org--open-elisp-link) - ("file" :complete org-file-complete-link) - ("ftp" :follow (lambda (path) (browse-url (concat "ftp:" path)))) - ("help" :follow org--open-help-link) - ("http" :follow (lambda (path) (browse-url (concat "http:" path)))) - ("https" :follow (lambda (path) (browse-url (concat "https:" path)))) - ("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path)))) - ("news" :follow (lambda (path) (browse-url (concat "news:" path)))) - ("shell" :follow org--open-shell-link)) - "An alist of properties that defines all the links in Org mode. -The key in each association is a string of the link type. -Subsequent optional elements make up a p-list of link properties. - -:follow - A function that takes the link path as an argument. - -:export - A function that takes the link path, description and -export-backend as arguments. - -:store - A function responsible for storing the link. See the -function `org-store-link-functions'. - -:complete - A function that inserts a link with completion. The -function takes one optional prefix arg. - -:face - A face for the link, or a function that returns a face. -The function takes one argument which is the link path. The -default face is `org-link'. - -:mouse-face - The mouse-face. The default is `highlight'. - -:display - `full' will not fold the link in descriptive -display. Default is `org-link'. - -:help-echo - A string or function that takes (window object position) -as arguments and returns a string. - -:keymap - A keymap that is active on the link. The default is -`org-mouse-map'. - -:htmlize-link - A function for the htmlize-link. Defaults -to (list :uri \"type:path\") - -:activate-func - A function to run at the end of font-lock -activation. The function must accept (link-start link-end path bracketp) -as arguments." - :group 'org-link - :type '(alist :tag "Link display parameters" - :value-type plist) - :version "26.1" - :package-version '(Org . "9.1")) - -(defun org-link-get-parameter (type key) - "Get TYPE link property for KEY. -TYPE is a string and KEY is a plist keyword." - (plist-get - (cdr (assoc type org-link-parameters)) - key)) - -(defun org-link-set-parameters (type &rest parameters) - "Set link TYPE properties to PARAMETERS. - PARAMETERS should be :key val pairs." - (let ((data (assoc type org-link-parameters))) - (if data (setcdr data (org-combine-plists (cdr data) parameters)) - (push (cons type parameters) org-link-parameters) - (org-make-link-regexps) - (org-element-update-syntax)))) - -(defun org-link-types () - "Return a list of known link types." - (mapcar #'car org-link-parameters)) - -(defcustom org-link-abbrev-alist nil - "Alist of link abbreviations. -The car of each element is a string, to be replaced at the start of a link. -The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated -links in Org buffers can have an optional tag after a double colon, e.g., - - [[linkkey:tag][description]] - -The `linkkey' must be a single word, starting with a letter, followed -by letters, numbers, `-' or `_'. - -If REPLACE is a string, the tag will simply be appended to create the link. -If the string contains \"%s\", the tag will be inserted there. If the string -contains \"%h\", it will cause a url-encoded version of the tag to be inserted -at that point (see the function `url-hexify-string'). If the string contains -the specifier \"%(my-function)\", then the custom function `my-function' will -be invoked: this function takes the tag as its only argument and must return -a string. - -REPLACE may also be a function that will be called with the tag as the -only argument to create the link, which should be returned as a string. - -See the manual for examples." - :group 'org-link - :type '(repeat - (cons - (string :tag "Protocol") - (choice - (string :tag "Format") - (function))))) - -(defcustom org-descriptive-links t - "Non-nil means Org will display descriptive links. -E.g. [[https://orgmode.org][Org website]] will be displayed as -\"Org Website\", hiding the link itself and just displaying its -description. When set to nil, Org will display the full links -literally. - -You can interactively set the value of this variable by calling -`org-toggle-link-display' or from the menu Org>Hyperlinks menu." - :group 'org-link - :type 'boolean) - -(defcustom org-link-file-path-type 'adaptive - "How the path name in file links should be stored. -Valid values are: - -relative Relative to the current directory, i.e. the directory of the file - into which the link is being inserted. -absolute Absolute path, if possible with ~ for home directory. -noabbrev Absolute path, no abbreviation of home directory. -adaptive Use relative path for files in the current directory and sub- - directories of it. For other files, use an absolute path." - :group 'org-link - :type '(choice - (const relative) - (const absolute) - (const noabbrev) - (const adaptive))) - (defvaralias 'org-activate-links 'org-highlight-links) (defcustom org-highlight-links '(bracket angle plain radio tag date footnote) "Types of links that should be highlighted in Org files. @@ -1846,7 +1862,6 @@ footnote Footnote labels. If you set this variable during an Emacs session, use `org-mode-restart' in the Org buffer so that the change takes effect." - :group 'org-link :group 'org-appearance :type '(set :greedy t (const :tag "Double bracket links" bracket) @@ -1857,408 +1872,12 @@ in the Org buffer so that the change takes effect." (const :tag "Timestamps" date) (const :tag "Footnotes" footnote))) -(defcustom org-make-link-description-function nil - "Function to use for generating link descriptions from links. -This function must take two parameters: the first one is the -link, the second one is the description generated by -`org-insert-link'. The function should return the description to -use." - :group 'org-link - :type '(choice (const nil) (function))) - -(defgroup org-link-store nil - "Options concerning storing links in Org mode." - :tag "Org Store Link" - :group 'org-link) - -(defcustom org-url-hexify-p t - "When non-nil, hexify URL when creating a link." - :type 'boolean - :version "24.3" - :group 'org-link-store) - -(defcustom org-email-link-description-format "Email %c: %s" - "Format of the description part of a link to an email or usenet message. -The following %-escapes will be replaced by corresponding information: - -%F full \"From\" field -%f name, taken from \"From\" field, address if no name -%T full \"To\" field -%t first name in \"To\" field, address if no name -%c correspondent. Usually \"from NAME\", but if you sent it yourself, it - will be \"to NAME\". See also the variable `org-from-is-user-regexp'. -%s subject -%d date -%m message-id. - -You may use normal field width specification between the % and the letter. -This is for example useful to limit the length of the subject. - -Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\"" - :group 'org-link-store - :package-version '(Org . "9.3") - :type 'string - :safe #'stringp) - -(defcustom org-from-is-user-regexp - (let (r1 r2) - (when (and user-mail-address (not (string= user-mail-address ""))) - (setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>"))) - (when (and user-full-name (not (string= user-full-name ""))) - (setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>"))) - (if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2))) - "Regexp matched against the \"From:\" header of an email or usenet message. -It should match if the message is from the user him/herself." - :group 'org-link-store - :type 'regexp) - -(defcustom org-context-in-file-links t - "Non-nil means file links from `org-store-link' contain context. -\\<org-mode-map> -A search string will be added to the file name with :: as separator -and used to find the context when the link is activated by the command -`org-open-at-point'. When this option is t, the entire active region -will be placed in the search string of the file link. If set to a -positive integer, only the first n lines of context will be stored. - -Using a prefix arg to the command `org-store-link' (`\\[universal-argument] \ -\\[org-store-link]') -negates this setting for the duration of the command." - :group 'org-link-store - :type '(choice boolean integer)) - -(defcustom org-keep-stored-link-after-insertion nil - "Non-nil means keep link in list for entire session. -\\<org-mode-map> -The command `org-store-link' adds a link pointing to the current -location to an internal list. These links accumulate during a session. -The command `org-insert-link' can be used to insert links into any -Org file (offering completion for all stored links). - -When this option is nil, every link which has been inserted once using -`\\[org-insert-link]' will be removed from the list, to make completing the \ -unused -links more efficient." - :group 'org-link-store - :type 'boolean) - -(defgroup org-link-follow nil - "Options concerning following links in Org mode." - :tag "Org Follow Link" - :group 'org-link) - -(defcustom org-link-translation-function nil - "Function to translate links with different syntax to Org syntax. -This can be used to translate links created for example by the Planner -or emacs-wiki packages to Org syntax. -The function must accept two parameters, a TYPE containing the link -protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, -which is everything after the link protocol. It should return a cons -with possibly modified values of type and path. -Org contains a function for this, so if you set this variable to -`org-translate-link-from-planner', you should be able follow many -links created by planner." - :group 'org-link-follow - :type '(choice (const nil) (function))) - (defcustom org-mark-ring-length 4 "Number of different positions to be recorded in the ring. Changing this requires a restart of Emacs to work correctly." :group 'org-link-follow :type 'integer) -(defcustom org-link-search-must-match-exact-headline 'query-to-create - "Non-nil means internal fuzzy links can only match headlines. - -When nil, the a fuzzy link may point to a target or a named -construct in the document. When set to the special value -`query-to-create', offer to create a new headline when none -matched. - -Spaces and statistics cookies are ignored during heading searches." - :group 'org-link-follow - :version "24.1" - :type '(choice - (const :tag "Use fuzzy text search" nil) - (const :tag "Match only exact headline" t) - (const :tag "Match exact headline or query to create it" - query-to-create)) - :safe #'symbolp) - -(defcustom org-link-frame-setup - '((vm . vm-visit-folder-other-frame) - (vm-imap . vm-visit-imap-folder-other-frame) - (gnus . org-gnus-no-new-news) - (file . find-file-other-window) - (wl . wl-other-frame)) - "Setup the frame configuration for following links. -When following a link with Emacs, it may often be useful to display -this link in another window or frame. This variable can be used to -set this up for the different types of links. -For VM, use any of - `vm-visit-folder' - `vm-visit-folder-other-window' - `vm-visit-folder-other-frame' -For Gnus, use any of - `gnus' - `gnus-other-frame' - `org-gnus-no-new-news' -For FILE, use any of - `find-file' - `find-file-other-window' - `find-file-other-frame' -For Wanderlust use any of - `wl' - `wl-other-frame' -For the calendar, use the variable `calendar-setup'. -For BBDB, it is currently only possible to display the matches in -another window." - :group 'org-link-follow - :type '(list - (cons (const vm) - (choice - (const vm-visit-folder) - (const vm-visit-folder-other-window) - (const vm-visit-folder-other-frame))) - (cons (const vm-imap) - (choice - (const vm-visit-imap-folder) - (const vm-visit-imap-folder-other-window) - (const vm-visit-imap-folder-other-frame))) - (cons (const gnus) - (choice - (const gnus) - (const gnus-other-frame) - (const org-gnus-no-new-news))) - (cons (const file) - (choice - (const find-file) - (const find-file-other-window) - (const find-file-other-frame))) - (cons (const wl) - (choice - (const wl) - (const wl-other-frame))))) - -(defcustom org-display-internal-link-with-indirect-buffer nil - "Non-nil means use indirect buffer to display infile links. -Activating internal links (from one location in a file to another location -in the same file) normally just jumps to the location. When the link is -activated with a `\\[universal-argument]' prefix (or with mouse-3), the link \ -is displayed in -another window. When this option is set, the other window actually displays -an indirect buffer clone of the current buffer, to avoid any visibility -changes to the current buffer." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-open-non-existing-files nil - "Non-nil means `org-open-file' will open non-existing files. -When nil, an error will be generated. -This variable applies only to external applications because they -might choke on non-existing files. If the link is to a file that -will be opened in Emacs, the variable is ignored." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-open-directory-means-index-dot-org nil - "Non-nil means a link to a directory really means to index.org. -When nil, following a directory link will run dired or open a finder/explorer -window on that directory." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-confirm-shell-link-function 'yes-or-no-p - "Non-nil means ask for confirmation before executing shell links. -Shell links can be dangerous: just think about a link - - [[shell:rm -rf ~/*][Google Search]] - -This link would show up in your Org document as \"Google Search\", -but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' if you want to confirm with a -single keystroke rather than having to type \"yes\"." - :group 'org-link-follow - :type '(choice - (const :tag "with yes-or-no (safer)" yes-or-no-p) - (const :tag "with y-or-n (faster)" y-or-n-p) - (const :tag "no confirmation (dangerous)" nil))) -(put 'org-confirm-shell-link-function - 'safe-local-variable - (lambda (x) (member x '(yes-or-no-p y-or-n-p)))) - -(defcustom org-confirm-shell-link-not-regexp "" - "A regexp to skip confirmation for shell links." - :group 'org-link-follow - :version "24.1" - :type 'regexp) - -(defcustom org-confirm-elisp-link-function 'yes-or-no-p - "Non-nil means ask for confirmation before executing Emacs Lisp links. -Elisp links can be dangerous: just think about a link - - [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] - -This link would show up in your Org document as \"Google Search\", -but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' if you want to confirm with a -single keystroke rather than having to type \"yes\"." - :group 'org-link-follow - :type '(choice - (const :tag "with yes-or-no (safer)" yes-or-no-p) - (const :tag "with y-or-n (faster)" y-or-n-p) - (const :tag "no confirmation (dangerous)" nil))) -(put 'org-confirm-shell-link-function - 'safe-local-variable - (lambda (x) (member x '(yes-or-no-p y-or-n-p)))) - -(defcustom org-confirm-elisp-link-not-regexp "" - "A regexp to skip confirmation for Elisp links." - :group 'org-link-follow - :version "24.1" - :type 'regexp) - -(defconst org-file-apps-defaults-gnu - '((remote . emacs) - (system . mailcap) - (t . mailcap)) - "Default file applications on a UNIX or GNU/Linux system. -See `org-file-apps'.") - -(defconst org-file-apps-defaults-macosx - '((remote . emacs) - (system . "open %s") - ("ps.gz" . "gv %s") - ("eps.gz" . "gv %s") - ("dvi" . "xdvi %s") - ("fig" . "xfig %s") - (t . "open %s")) - "Default file applications on a macOS system. -The system \"open\" is known as a default, but we use X11 applications -for some files for which the OS does not have a good default. -See `org-file-apps'.") - -(defconst org-file-apps-defaults-windowsnt - (list '(remote . emacs) - (cons 'system (lambda (file _path) - (with-no-warnings (w32-shell-execute "open" file)))) - (cons t (lambda (file _path) - (with-no-warnings (w32-shell-execute "open" file))))) - "Default file applications on a Windows NT system. -The system \"open\" is used for most files. -See `org-file-apps'.") - -(defcustom org-file-apps - '((auto-mode . emacs) - ("\\.mm\\'" . default) - ("\\.x?html?\\'" . default) - ("\\.pdf\\'" . default)) - "External applications for opening `file:path' items in a document. -\\<org-mode-map>\ - -Org mode uses system defaults for different file types, but -you can use this variable to set the application for a given file -extension. The entries in this list are cons cells where the car identifies -files and the cdr the corresponding command. - -Possible values for the file identifier are: - - \"string\" A string as a file identifier can be interpreted in different - ways, depending on its contents: - - - Alphanumeric characters only: - Match links with this file extension. - Example: (\"pdf\" . \"evince %s\") - to open PDFs with evince. - - - Regular expression: Match links where the - filename matches the regexp. If you want to - use groups here, use shy groups. - - Example: (\"\\\\.x?html\\\\\\='\" . \"firefox %s\") - (\"\\\\(?:xhtml\\\\|html\\\\)\\\\\\='\" . \"firefox %s\") - to open *.html and *.xhtml with firefox. - - - Regular expression which contains (non-shy) groups: - Match links where the whole link, including \"::\", and - anything after that, matches the regexp. - In a custom command string, %1, %2, etc. are replaced with - the parts of the link that were matched by the groups. - For backwards compatibility, if a command string is given - that does not use any of the group matches, this case is - handled identically to the second one (i.e. match against - file name only). - In a custom function, you can access the group matches with - (match-string n link). - - Example: (\"\\\\.pdf::\\\\([0-9]+\\\\)\\\\\\='\" . \ -\"evince -p %1 %s\") - to open [[file:document.pdf::5]] with evince at page 5. - - `directory' Matches a directory - `remote' Matches a remote file, accessible through tramp or efs. - Remote files most likely should be visited through Emacs - because external applications cannot handle such paths. -`auto-mode' Matches files that are matched by any entry in `auto-mode-alist', - so all files Emacs knows how to handle. Using this with - command `emacs' will open most files in Emacs. Beware that this - will also open html files inside Emacs, unless you add - (\"html\" . default) to the list as well. - `system' The system command to open files, like `open' on Windows - and macOS, and mailcap under GNU/Linux. This is the command - that will be selected if you call `org-open-at-point' with a - double prefix argument (`\\[universal-argument] \ -\\[universal-argument] \\[org-open-at-point]'). - t Default for files not matched by any of the other options. - -Possible values for the command are: - - `emacs' The file will be visited by the current Emacs process. - `default' Use the default application for this file type, which is the - association for t in the list, most likely in the system-specific - part. This can be used to overrule an unwanted setting in the - system-specific variable. - `system' Use the system command for opening files, like \"open\". - This command is specified by the entry whose car is `system'. - Most likely, the system-specific version of this variable - does define this command, but you can overrule/replace it - here. -`mailcap' Use command specified in the mailcaps. - string A command to be executed by a shell; %s will be replaced - by the path to the file. - function A Lisp function, which will be called with two arguments: - the file path and the original link string, without the - \"file:\" prefix. - -For more examples, see the system specific constants -`org-file-apps-defaults-macosx' -`org-file-apps-defaults-windowsnt' -`org-file-apps-defaults-gnu'." - :group 'org-link-follow - :type '(repeat - (cons (choice :value "" - (string :tag "Extension") - (const :tag "System command to open files" system) - (const :tag "Default for unrecognized files" t) - (const :tag "Remote file" remote) - (const :tag "Links to a directory" directory) - (const :tag "Any files that have Emacs modes" - auto-mode)) - (choice :value "" - (const :tag "Visit with Emacs" emacs) - (const :tag "Use default" default) - (const :tag "Use the system command" system) - (string :tag "Command") - (function :tag "Function"))))) - -(defcustom org-doi-server-url "http://dx.doi.org/" - "The URL of the DOI server." - :type 'string - :version "24.3" - :group 'org-link-follow) - (defgroup org-refile nil "Options concerning refiling entries in Org mode." :tag "Org Refile" @@ -5336,7 +4955,7 @@ The following commands are available: \\{org-mode-map}" (org-load-modules-maybe) (org-install-agenda-files-menu) - (when org-descriptive-links (add-to-invisibility-spec '(org-link))) + (when org-link-descriptive (add-to-invisibility-spec '(org-link))) (add-to-invisibility-spec '(org-hide-block . t)) (add-to-invisibility-spec '(org-hide-drawer . t)) (setq-local outline-regexp org-outline-regexp) @@ -5515,34 +5134,6 @@ the rounding returns a past time." (require 'font-lock) -(defconst org-non-link-chars "]\t\n\r<>") -(defvar org-link-types-re nil - "Matches a link that has a url-like prefix like \"http:\"") -(defvar org-link-re-with-space nil - "Matches a link with spaces, optional angular brackets around it.") -(defvar org-link-re-with-space2 nil - "Matches a link with spaces, optional angular brackets around it.") -(defvar org-link-re-with-space3 nil - "Matches a link with spaces, only for internal part in bracket links.") -(defvar org-angle-link-re nil - "Matches link with angular brackets, spaces are allowed.") -(defvar org-plain-link-re nil - "Matches plain link, without spaces.") -(defvar org-bracket-link-regexp nil - "Matches a link in double brackets.") -(defvar org-bracket-link-analytic-regexp nil - "Regular expression used to analyze links. -Here is what the match groups contain after a match: -1: http: -2: http -3: path -4: [desc] -5: desc") -(defvar org-bracket-link-analytic-regexp++ nil - "Like `org-bracket-link-analytic-regexp', but include coderef internal type.") -(defvar org-any-link-re nil - "Regular expression matching any link.") - (defconst org-match-sexp-depth 3 "Number of stacked braces for sub/superscript matching.") @@ -5580,59 +5171,6 @@ stacked delimiters is N. Escaping delimiters is not possible." "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)") "The regular expression matching a sub- or superscript, forcing braces.") -(defun org-make-link-regexps () - "Update the link regular expressions. -This should be called after the variable `org-link-parameters' has changed." - (let ((types-re (regexp-opt (org-link-types) t))) - (setq org-link-types-re - (concat "\\`" types-re ":") - org-link-re-with-space - (concat "<?" types-re ":" - "\\([^" org-non-link-chars " ]" - "[^" org-non-link-chars "]*" - "[^" org-non-link-chars " ]\\)>?") - org-link-re-with-space2 - (concat "<?" types-re ":" - "\\([^" org-non-link-chars " ]" - "[^\t\n\r]*" - "[^" org-non-link-chars " ]\\)>?") - org-link-re-with-space3 - (concat "<?" types-re ":" - "\\([^" org-non-link-chars " ]" - "[^\t\n\r]*\\)") - org-angle-link-re - (format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>" - types-re) - org-plain-link-re - (concat - "\\<" types-re ":" - "\\([^][ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)") - ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") - org-bracket-link-regexp - "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" - org-bracket-link-analytic-regexp - (concat - "\\[\\[" - "\\(" types-re ":\\)?" - "\\([^]]+\\)" - "\\]" - "\\(\\[" "\\([^]]+\\)" "\\]\\)?" - "\\]") - org-bracket-link-analytic-regexp++ - (concat - "\\[\\[" - "\\(" (regexp-opt (cons "coderef" (org-link-types)) t) ":\\)?" - "\\([^]]+\\)" - "\\]" - "\\(\\[" "\\([^]]+\\)" "\\]\\)?" - "\\]") - org-any-link-re - (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" - org-angle-link-re "\\)\\|\\(" - org-plain-link-re "\\)")))) - -(org-make-link-regexps) - (defvar org-emph-face nil) (defun org-do-emphasis-faces (limit) @@ -5738,7 +5276,7 @@ prompted for." "Add link properties to links. This includes angle, plain, and bracket links." (catch :exit - (while (re-search-forward org-any-link-re limit t) + (while (re-search-forward org-link-any-re limit t) (let* ((start (match-beginning 0)) (end (match-end 0)) (style (cond ((eq ?< (char-after start)) 'angle) @@ -6015,21 +5553,6 @@ by a #." (org-display-custom-time (match-beginning 1) (match-end 1))) t)) -(defvar-local org-target-link-regexp nil - "Regular expression matching radio targets in plain text.") - -(defconst org-target-regexp (let ((border "[^<>\n\r \t]")) - (format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>" - border border border)) - "Regular expression matching a link target.") - -(defconst org-radio-target-regexp (format "<%s>" org-target-regexp) - "Regular expression matching a radio target.") - -(defconst org-any-target-regexp - (format "%s\\|%s" org-radio-target-regexp org-target-regexp) - "Regular expression matching any target.") - (defun org-activate-target-links (limit) "Add text properties for target matches." (when org-target-link-regexp @@ -6047,59 +5570,6 @@ by a #." (org-rear-nonsticky-at (match-end 1)) t)))) -(defun org-update-radio-target-regexp () - "Find all radio targets in this file and update the regular expression. -Also refresh fontification if needed." - (interactive) - (let ((old-regexp org-target-link-regexp) - ;; Some languages, e.g., Chinese, do not use spaces to - ;; separate words. Also allow to surround radio targets with - ;; line-breakable characters. - (before-re "\\(?:^\\|[^[:alnum:]]\\|\\c|\\)\\(") - (after-re "\\)\\(?:$\\|[^[:alnum:]]\\|\\c|\\)") - (targets - (org-with-wide-buffer - (goto-char (point-min)) - (let (rtn) - (while (re-search-forward org-radio-target-regexp nil t) - ;; Make sure point is really within the object. - (backward-char) - (let ((obj (org-element-context))) - (when (eq (org-element-type obj) 'radio-target) - (cl-pushnew (org-element-property :value obj) rtn - :test #'equal)))) - rtn)))) - (setq org-target-link-regexp - (and targets - (concat before-re - (mapconcat - (lambda (x) - (replace-regexp-in-string - " +" "\\s-+" (regexp-quote x) t t)) - targets - "\\|") - after-re))) - (unless (equal old-regexp org-target-link-regexp) - ;; Clean-up cache. - (let ((regexp (cond ((not old-regexp) org-target-link-regexp) - ((not org-target-link-regexp) old-regexp) - (t - (concat before-re - (mapconcat - (lambda (re) - (substring re (length before-re) - (- (length after-re)))) - (list old-regexp org-target-link-regexp) - "\\|") - after-re))))) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (org-element-cache-refresh (match-beginning 1))))) - ;; Re fontify buffer. - (when (memq 'radio org-highlight-links) - (org-restart-font-lock))))) - (defvar org-latex-and-related-regexp nil "Regular expression for highlighting LaTeX, entities and sub/superscript.") @@ -6272,7 +5742,8 @@ needs to be inserted at a specific position in the font-lock sequence.") (when (memq 'date lk) '(org-activate-dates (0 'org-date t))) (when (memq 'footnote lk) '(org-activate-footnote-links)) ;; Targets. - (list org-any-target-regexp '(0 'org-target t)) + (list org-radio-target-regexp '(0 'org-target t)) + (list org-target-regexp '(0 'org-target t)) ;; Diary sexps. '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) ;; Macro @@ -9001,917 +8472,6 @@ sub-tree if optional argument INHERIT is non-nil." '((effort . identity) (effort-minutes . org-duration-to-minutes)))) -;;;; Link Stuff - -;;; Link abbreviations - -(defun org-link-expand-abbrev (link) - "Apply replacements as defined in `org-link-abbrev-alist'." - (if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link) - (let* ((key (match-string 1 link)) - (as (or (assoc key org-link-abbrev-alist-local) - (assoc key org-link-abbrev-alist))) - (tag (and (match-end 2) (match-string 3 link))) - rpl) - (if (not as) - link - (setq rpl (cdr as)) - (cond - ((symbolp rpl) (funcall rpl tag)) - ((string-match "%(\\([^)]+\\))" rpl) - (replace-match - (save-match-data - (funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl)) - ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) - ((string-match "%h" rpl) - (replace-match (url-hexify-string (or tag "")) t t rpl)) - (t (concat rpl tag))))) - link)) - -;;; Storing and inserting links - -(defvar org-insert-link-history nil - "Minibuffer history for links inserted with `org-insert-link'.") - -(defvar org-stored-links nil - "Contains the links stored with `org-store-link'.") - -(defvar org-store-link-plist nil - "Plist with info about the most recently link created with `org-store-link'.") - -(defun org-store-link-functions () - "Return a list of functions that are called to create and store a link. - -The functions are defined in the `:store' property of -`org-link-parameters'. - -Each function is called in turn until one returns a non-nil -value. Each function should check if it is responsible for -creating this link (for example by looking at the major mode). -If not, it must exit and return nil. If yes, it should return -a non-nil value after calling `org-store-link-props' with a list -of properties and values. Special properties are: - -:type The link prefix, like \"http\". This must be given. -:link The link, like \"http://www.astro.uva.nl/~dominik\". - This is obligatory as well. -:description Optional default description for the second pair - of brackets in an Org mode link. The user can still change - this when inserting this link into an Org mode buffer. - -In addition to these, any additional properties can be specified -and then used in capture templates." - (cl-loop for link in org-link-parameters - with store-func - do (setq store-func (org-link-get-parameter (car link) :store)) - if store-func - collect store-func)) - -(defvar org-agenda-buffer-name) ; Defined in org-agenda.el -(defvar org-id-link-to-org-use-id) ; Defined in org-id.el - -;;;###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 description search txt custom-id agenda-link) - (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-store-link-props - (cdr (assoc-string - (completing-read - "Which function for creating the link? " - (mapcar #'car results-alist) - nil t (symbol-name name)) - results-alist))) - t)))) - (setq link (plist-get org-store-link-plist :link)) - (setq desc (or (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-store-link-props :type "calendar" :date cd))) - - ((eq major-mode 'help-mode) - (setq link (concat "help:" (save-excursion - (goto-char (point-min)) - (looking-at "^[^ ]+") - (match-string 0)))) - (org-store-link-props :type "help")) - - ((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-store-link-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-store-link-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 description link))) - - ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) - (org-with-limited-levels - (setq custom-id (org-entry-get nil "CUSTOM_ID")) - (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)) - ((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")))) - ;; Store a link using the ID at point - (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-context-in-file-links - (equal arg '(4))) - (let* ((element (org-element-at-point)) - (name (org-element-property :name element))) - (setq txt (cond - ((org-at-heading-p) nil) - (name) - ((org-region-active-p) - (buffer-substring (region-beginning) (region-end))))) - (when (or (null txt) (string-match "\\S-" txt)) - (setq cpltxt - (concat cpltxt "::" - (condition-case nil - (org-make-org-heading-search-string txt) - (error ""))) - desc (or name - (nth 4 (ignore-errors (org-heading-components))) - "NONE"))))) - (when (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (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 string. - (when (org-xor org-context-in-file-links - (equal arg '(4))) - (setq txt (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)) - (buffer-substring (point-at-bol) (point-at-eol)))) - ;; Only use search option if there is some text. - (when (string-match "\\S-" txt) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - 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 - (replace-regexp-in-string - org-bracket-link-analytic-regexp - (lambda (m) (or (match-string 5 m) (match-string 3 m))) - desc)))) - ;; Return the link - (if (not (and interactive? link)) - (or agenda-link (and link (org-make-link-string link desc))) - (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)) "::#" custom-id)) - (push (list link desc) org-stored-links)) - (car org-stored-links))))) - -(defun org-store-link-props (&rest plist) - "Store link properties. -The properties are pre-processed by extracting names, addresses -and dates." - (let ((x (plist-get plist :from))) - (when x - (let ((adr (mail-extract-address-components x))) - (setq plist (plist-put plist :fromname (car adr))) - (setq plist (plist-put plist :fromaddress (nth 1 adr)))))) - (let ((x (plist-get plist :to))) - (when x - (let ((adr (mail-extract-address-components x))) - (setq plist (plist-put plist :toname (car adr))) - (setq plist (plist-put plist :toaddress (nth 1 adr)))))) - (let ((x (ignore-errors (date-to-time (plist-get plist :date))))) - (when x - (setq plist (plist-put plist :date-timestamp - (format-time-string - (org-time-stamp-format t) x))) - (setq plist (plist-put plist :date-timestamp-inactive - (format-time-string - (org-time-stamp-format t t) x))))) - (let ((from (plist-get plist :from)) - (to (plist-get plist :to))) - (when (and from to org-from-is-user-regexp) - (setq plist - (plist-put plist :fromto - (if (string-match org-from-is-user-regexp from) - (concat "to %t") - (concat "from %f")))))) - (setq org-store-link-plist plist)) - -(defun org-add-link-props (&rest plist) - "Add these properties to the link property list." - (let (key value) - (while plist - (setq key (pop plist) value (pop plist)) - (setq org-store-link-plist - (plist-put org-store-link-plist key value))))) - -(defun org-email-link-description (&optional fmt) - "Return the description part of an email link. -This takes information from `org-store-link-plist' and formats it -according to FMT (default from `org-email-link-description-format')." - (setq fmt (or fmt org-email-link-description-format)) - (let* ((p org-store-link-plist) - (to (plist-get p :toaddress)) - (from (plist-get p :fromaddress)) - (table - (list - (cons "%c" (plist-get p :fromto)) - (cons "%F" (plist-get p :from)) - (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?")) - (cons "%T" (plist-get p :to)) - (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?")) - (cons "%s" (plist-get p :subject)) - (cons "%d" (plist-get p :date)) - (cons "%m" (plist-get p :message-id))))) - (when (string-match "%c" fmt) - ;; Check if the user wrote this message - (if (and org-from-is-user-regexp from to - (save-match-data (string-match org-from-is-user-regexp from))) - (setq fmt (replace-match "to %t" t t fmt)) - (setq fmt (replace-match "from %f" t t fmt)))) - (org-replace-escapes fmt table))) - -(defun org-make-org-heading-search-string (&optional string) - "Make search string for the current headline or STRING." - (let ((s (or string - (and (derived-mode-p 'org-mode) - (save-excursion - (org-back-to-heading t) - (org-element-property :raw-value (org-element-at-point)))))) - (lines org-context-in-file-links)) - (unless string (setq s (concat "*" s))) ;Add * for headlines - (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s)) - (when (and string (integerp lines) (> lines 0)) - (let ((slines (org-split-string s "\n"))) - (when (< lines (length slines)) - (setq s (mapconcat - 'identity - (reverse (nthcdr (- (length slines) lines) - (reverse slines))) "\n"))))) - (mapconcat #'identity (split-string s) " "))) - -(defconst org-link-escape-chars - ;;%20 %5B %5D %25 - '(?\s ?\[ ?\] ?%) - "List of characters that should be escaped in a link when stored to Org. -This is the list that is used for internal purposes.") - -(defun org-make-link-string (link &optional description) - "Make a link with brackets, consisting of LINK and DESCRIPTION." - (unless (org-string-nw-p link) (error "Empty link")) - (let ((uri (cond ((string-match org-link-types-re link) - (concat (match-string 1 link) - (org-link-escape (substring link (match-end 1))))) - ((or (file-name-absolute-p link) - (string-match-p "\\`\\.\\.?/" link)) - (org-link-escape link)) - ;; For readability, do not encode space characters - ;; in fuzzy links. - (t (org-link-escape link (remq ?\s org-link-escape-chars))))) - (description - (and (org-string-nw-p description) - ;; Remove brackets from description, as they are fatal. - (replace-regexp-in-string - "[][]" (lambda (m) (if (equal "[" m) "{" "}")) - (org-trim description))))) - (format "[[%s]%s]" - uri - (if description (format "[%s]" description) "")))) - -(defun org-link-escape (text &optional table merge) - "Return percent escaped representation of TEXT. -TEXT is a string with the text to escape. -Optional argument TABLE is a list with characters that should be -escaped. When nil, `org-link-escape-chars' is used. -If optional argument MERGE is set, merge TABLE into -`org-link-escape-chars'." - (let ((characters-to-encode - (cond ((null table) org-link-escape-chars) - (merge (append org-link-escape-chars table)) - (t table)))) - (mapconcat - (lambda (c) - (if (or (memq c characters-to-encode) - (and org-url-hexify-p (or (< c 32) (> c 126)))) - (mapconcat (lambda (e) (format "%%%.2X" e)) - (or (encode-coding-char c 'utf-8) - (error "Unable to percent escape character: %c" c)) - "") - (char-to-string c))) - text ""))) - -(defun org-link-unescape (str) - "Unhex hexified Unicode parts in string STR. -E.g. `%C3%B6' becomes the german o-Umlaut. This is the -reciprocal of `org-link-escape', which see." - (if (org-string-nw-p str) - (replace-regexp-in-string - "\\(%[0-9A-Za-z]\\{2\\}\\)+" #'org-link-unescape-compound str t t) - str)) - -(defun org-link-unescape-compound (hex) - "Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German o-Umlaut. -Note: this function also decodes single byte encodings like -`%E1' (a-acute) if not followed by another `%[A-F0-9]{2}' group." - (save-match-data - (let* ((bytes (cdr (split-string hex "%"))) - (ret "") - (eat 0) - (sum 0)) - (while bytes - (let* ((val (string-to-number (pop bytes) 16)) - (shift-xor - (if (= 0 eat) - (cond - ((>= val 252) (cons 6 252)) - ((>= val 248) (cons 5 248)) - ((>= val 240) (cons 4 240)) - ((>= val 224) (cons 3 224)) - ((>= val 192) (cons 2 192)) - (t (cons 0 0))) - (cons 6 128)))) - (when (>= val 192) (setq eat (car shift-xor))) - (setq val (logxor val (cdr shift-xor))) - (setq sum (+ (ash sum (car shift-xor)) val)) - (when (> eat 0) (setq eat (- eat 1))) - (cond - ((= 0 eat) ;multi byte - (setq ret (concat ret (char-to-string sum))) - (setq sum 0)) - ((not bytes) ; single byte(s) - (setq ret (org-link-unescape-single-byte-sequence hex)))))) - ret))) - -(defun org-link-unescape-single-byte-sequence (hex) - "Unhexify hex-encoded single byte character sequences." - (mapconcat (lambda (byte) - (char-to-string (string-to-number byte 16))) - (cdr (split-string hex "%")) "")) - -(defun org-fixup-message-id-for-http (s) - "Replace special characters in a message id, so it can be used in an http query." - (when (string-match "%" s) - (setq s (mapconcat (lambda (c) - (if (eq c ?%) - "%25" - (char-to-string c))) - s ""))) - (while (string-match "<" s) - (setq s (replace-match "%3C" t t s))) - (while (string-match ">" s) - (setq s (replace-match "%3E" t t s))) - (while (string-match "@" s) - (setq s (replace-match "%40" t t s))) - s) - -(defun org-link-prettify (link) - "Return a human-readable representation of LINK. -The car of LINK must be a raw link. -The cdr of LINK must be either a link description or nil." - (let ((desc (or (cadr link) "<no description>"))) - (concat (format "%-45s" (substring desc 0 (min (length desc) 40))) - "<" (car link) ">"))) - -;;;###autoload -(defun org-insert-link-global () - "Insert a link like Org mode does. -This command can be called in any mode to insert a link in Org syntax." - (interactive) - (org-load-modules-maybe) - (org-run-like-in-org-mode 'org-insert-link)) - -(defun org-insert-all-links (arg &optional pre post) - "Insert all links in `org-stored-links'. -When a universal prefix, do not delete the links from `org-stored-links'. -When `ARG' is a number, insert the last N link(s). -`PRE' and `POST' are optional arguments to define a string to -prepend or to append." - (interactive "P") - (let ((org-keep-stored-link-after-insertion (equal arg '(4))) - (links (copy-sequence org-stored-links)) - (pr (or pre "- ")) - (po (or post "\n")) - (cnt 1) l) - (if (null org-stored-links) - (message "No link to insert") - (while (and (or (listp arg) (>= arg cnt)) - (setq l (if (listp arg) - (pop links) - (pop org-stored-links)))) - (setq cnt (1+ cnt)) - (insert pr) - (org-insert-link nil (car l) (or (cadr l) "<no description>")) - (insert po))))) - -(defun org-insert-last-stored-link (arg) - "Insert the last link stored in `org-stored-links'." - (interactive "p") - (org-insert-all-links arg "" "\n")) - -(defun org-link-fontify-links-to-this-file () - "Fontify links to the current file in `org-stored-links'." - (let ((f (buffer-file-name)) a b) - (setq a (mapcar (lambda(l) - (let ((ll (car l))) - (when (and (string-match "^file:\\(.+\\)::" ll) - (equal f (expand-file-name (match-string 1 ll)))) - ll))) - org-stored-links)) - (when (featurep 'org-id) - (setq b (mapcar (lambda(l) - (let ((ll (car l))) - (when (and (string-match "^id:\\(.+\\)$" ll) - (equal f (expand-file-name - (or (org-id-find-id-file - (match-string 1 ll)) "")))) - ll))) - org-stored-links))) - (mapcar (lambda(l) - (put-text-property 0 (length l) 'face 'font-lock-comment-face l)) - (delq nil (append a b))))) - -(defvar org--links-history nil) -(defun org-insert-link (&optional complete-file link-location default-description) - "Insert a link. At the prompt, enter the link. - -Completion can be used to insert any of the link protocol prefixes in use. - -The history can be used to select a link previously stored with -`org-store-link'. When the empty string is entered (i.e. if you just -press `RET' at the prompt), the link defaults to the most recently -stored link. As `SPC' triggers completion in the minibuffer, you need to -use `M-SPC' or `C-q SPC' to force the insertion of a space character. - -You will also be prompted for a description, and if one is given, it will -be displayed in the buffer instead of the link. - -If there is already a link at point, this command will allow you to edit -link and description parts. - -With a `\\[universal-argument]' prefix, prompts for a file to link to. The \ -file name can be -selected using completion. The path to the file will be relative to the -current directory if the file is in the current directory or a subdirectory. -Otherwise, the link will be the absolute path as completed in the minibuffer -\(i.e. normally ~/path/to/file). You can configure this behavior using the -option `org-link-file-path-type'. - -With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \ -absolute path even if the file is in -the current directory or below. - -A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ -prefix negates `org-keep-stored-link-after-insertion'. - -If the LINK-LOCATION parameter is non-nil, this value will be used as -the link location instead of reading one interactively. - -If the DEFAULT-DESCRIPTION parameter is non-nil, this value will -be used as the default description. Otherwise, if -`org-make-link-description-function' is non-nil, this function -will be called with the link target, and the result will be the -default link description. When called non-interactively, don't -allow to edit the default description." - (interactive "P") - (let* ((wcf (current-window-configuration)) - (origbuf (current-buffer)) - (region (when (org-region-active-p) - (buffer-substring (region-beginning) (region-end)))) - (remove (and region (list (region-beginning) (region-end)))) - (desc region) - (link link-location) - (abbrevs org-link-abbrev-alist-local) - entry all-prefixes auto-desc) - (cond - (link-location) ; specified by arg, just use it. - ((org-in-regexp org-bracket-link-regexp 1) - ;; We do have a link at point, and we are going to edit it. - (setq remove (list (match-beginning 0) (match-end 0))) - (setq desc (when (match-end 3) (match-string-no-properties 3))) - (setq link (read-string "Link: " - (org-link-unescape - (match-string-no-properties 1))))) - ((or (org-in-regexp org-angle-link-re) - (org-in-regexp org-plain-link-re)) - ;; Convert to bracket link - (setq remove (list (match-beginning 0) (match-end 0)) - link (read-string "Link: " - (org-unbracket-string "<" ">" (match-string 0))))) - ((member complete-file '((4) (16))) - ;; Completing read for file names. - (setq link (org-file-complete-link complete-file))) - (t - ;; Read link, with completion for stored links. - (org-link-fontify-links-to-this-file) - (org-switch-to-buffer-other-window "*Org Links*") - (with-current-buffer "*Org Links*" - (erase-buffer) - (insert "Insert a link. -Use TAB to complete link prefixes, then RET for type-specific completion support\n") - (when org-stored-links - (insert "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") - (insert (mapconcat 'org-link-prettify - (reverse org-stored-links) "\n"))) - (goto-char (point-min))) - (let ((cw (selected-window))) - (select-window (get-buffer-window "*Org Links*" 'visible)) - (with-current-buffer "*Org Links*" (setq truncate-lines t)) - (unless (pos-visible-in-window-p (point-max)) - (org-fit-window-to-buffer)) - (and (window-live-p cw) (select-window cw))) - (setq all-prefixes (append (mapcar 'car abbrevs) - (mapcar 'car org-link-abbrev-alist) - (org-link-types))) - (unwind-protect - ;; Fake a link history, containing the stored links. - (let ((org--links-history - (append (mapcar #'car org-stored-links) - org-insert-link-history))) - (setq link - (org-completing-read - "Link: " - (append - (mapcar (lambda (x) (concat x ":")) all-prefixes) - (mapcar #'car org-stored-links)) - nil nil nil - 'org--links-history - (caar org-stored-links))) - (unless (org-string-nw-p link) (user-error "No link selected")) - (dolist (l org-stored-links) - (when (equal link (cadr l)) - (setq link (car l)) - (setq auto-desc t))) - (when (or (member link all-prefixes) - (and (equal ":" (substring link -1)) - (member (substring link 0 -1) all-prefixes) - (setq link (substring link 0 -1)))) - (setq link (with-current-buffer origbuf - (org-link-try-special-completion link))))) - (set-window-configuration wcf) - (kill-buffer "*Org Links*")) - (setq entry (assoc link org-stored-links)) - (or entry (push link org-insert-link-history)) - (setq desc (or desc (nth 1 entry))))) - - (when (funcall (if (equal complete-file '(64)) 'not 'identity) - (not org-keep-stored-link-after-insertion)) - (setq org-stored-links (delq (assoc link org-stored-links) - org-stored-links))) - - (when (and (string-match org-plain-link-re link) - (not (string-match org-ts-regexp link))) - ;; URL-like link, normalize the use of angular brackets. - (setq link (org-unbracket-string "<" ">" link))) - - ;; Check if we are linking to the current file with a search - ;; option If yes, simplify the link by using only the search - ;; option. - (when (and buffer-file-name - (let ((case-fold-search nil)) - (string-match "\\`file:\\(.+?\\)::" link))) - (let ((path (match-string-no-properties 1 link)) - (search (substring-no-properties link (match-end 0)))) - (save-match-data - (when (equal (file-truename buffer-file-name) (file-truename path)) - ;; We are linking to this same file, with a search option - (setq link search))))) - - ;; Check if we can/should use a relative path. If yes, simplify - ;; the link. - (let ((case-fold-search nil)) - (when (string-match "\\`\\(file\\|docview\\):" link) - (let* ((type (match-string-no-properties 0 link)) - (path-start (match-end 0)) - (search (and (string-match "::\\(.*\\)\\'" link) - (match-string 1 link))) - (path - (if search - (substring-no-properties - link path-start (match-beginning 0)) - (substring-no-properties link (match-end 0)))) - (origpath path)) - (cond - ((or (eq org-link-file-path-type 'absolute) - (equal complete-file '(16))) - (setq path (abbreviate-file-name (expand-file-name path)))) - ((eq org-link-file-path-type 'noabbrev) - (setq path (expand-file-name path))) - ((eq org-link-file-path-type 'relative) - (setq path (file-relative-name path))) - (t - (save-match-data - (if (string-match (concat "^" (regexp-quote - (expand-file-name - (file-name-as-directory - default-directory)))) - (expand-file-name path)) - ;; We are linking a file with relative path name. - (setq path (substring (expand-file-name path) - (match-end 0))) - (setq path (abbreviate-file-name (expand-file-name path))))))) - (setq link (concat type path (and search (concat "::" search)))) - (when (equal desc origpath) - (setq desc path))))) - - (unless auto-desc - (let ((initial-input - (cond - (default-description) - ((not org-make-link-description-function) desc) - (t (condition-case nil - (funcall org-make-link-description-function link desc) - (error - (message "Can't get link description from `%s'" - (symbol-name org-make-link-description-function)) - (sit-for 2) - nil)))))) - (setq desc (if (called-interactively-p 'any) - (read-string "Description: " initial-input) - initial-input)))) - - (unless (org-string-nw-p desc) (setq desc nil)) - (when remove (apply 'delete-region remove)) - (insert (org-make-link-string link desc)) - ;; Redisplay so as the new link has proper invisible characters. - (sit-for 0))) - -(defun org-link-try-special-completion (type) - "If there is completion support for link type TYPE, offer it." - (let ((fun (org-link-get-parameter type :complete))) - (if (functionp fun) - (funcall fun) - (read-string "Link (no completion support): " (concat type ":"))))) - -(defun org-file-complete-link (&optional arg) - "Create a file link using completion." - (let ((file (read-file-name "File: ")) - (pwd (file-name-as-directory (expand-file-name "."))) - (pwd1 (file-name-as-directory (abbreviate-file-name - (expand-file-name "."))))) - (cond ((equal arg '(16)) - (concat "file:" - (abbreviate-file-name (expand-file-name file)))) - ((string-match - (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) - (concat "file:" (match-string 1 file))) - ((string-match - (concat "^" (regexp-quote pwd) "\\(.+\\)") - (expand-file-name file)) - (concat "file:" - (match-string 1 (expand-file-name file)))) - (t (concat "file:" file))))) - - -;;; Opening/following a link - -(defvar org-link-search-failed nil) - -(defvar org-open-link-functions nil - "Hook for functions finding a plain text link. -These functions must take a single argument, the link content. -They will be called for links that look like [[link text][description]] -when LINK TEXT does not have a protocol like \"http:\" and does not look -like a filename (e.g. \"./blue.png\"). - -These functions will be called *before* Org attempts to resolve the -link by doing text searches in the current buffer - so if you want a -link \"[[target]]\" to still find \"<<target>>\", your function should -handle this as a special case. - -When the function does handle the link, it must return a non-nil value. -If it decides that it is not responsible for this link, it must return -nil to indicate that that Org can continue with other options like -exact and fuzzy text search.") - -(defun org-next-link (&optional search-backward) - "Move forward to the next link. -If the link is in hidden text, expose it." - (interactive "P") - (when (and org-link-search-failed (eq this-command last-command)) - (goto-char (point-min)) - (message "Link search wrapped back to beginning of buffer")) - (setq org-link-search-failed nil) - (let* ((pos (point)) - (ct (org-context)) - (a (assq :link ct)) - (srch-fun (if search-backward 're-search-backward 're-search-forward))) - (cond (a (goto-char (nth (if search-backward 1 2) a))) - ((looking-at org-any-link-re) - ;; Don't stay stuck at link without an org-link face - (forward-char (if search-backward -1 1)))) - (if (funcall srch-fun org-any-link-re nil t) - (progn - (goto-char (match-beginning 0)) - (when (org-invisible-p) (org-show-context))) - (goto-char pos) - (setq org-link-search-failed t) - (message "No further link found")))) - -(defun org-previous-link () - "Move backward to the previous link. -If the link is in hidden text, expose it." - (interactive) - (org-next-link t)) - -(defun org-translate-link (s) - "Translate a link string if a translation function has been defined." - (with-temp-buffer - (insert (org-trim s)) - (org-trim (org-element-interpret-data (org-element-context))))) - -(defun org-translate-link-from-planner (type path) - "Translate a link from Emacs Planner syntax so that Org can follow it. -This is still an experimental function, your mileage may vary." - (cond - ((member type '("http" "https" "news" "ftp")) - ;; standard Internet links are the same. - nil) - ((and (equal type "irc") (string-match "^//" path)) - ;; Planner has two / at the beginning of an irc link, we have 1. - ;; We should have zero, actually.... - (setq path (substring path 1))) - ((and (equal type "lisp") (string-match "^/" path)) - ;; Planner has a slash, we do not. - (setq type "elisp" path (substring path 1))) - ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path) - ;; A typical message link. Planner has the id after the final slash, - ;; we separate it with a hash mark - (setq path (concat (match-string 1 path) "#" - (org-unbracket-string "<" ">" (match-string 2 path)))))) - (cons type path)) - (defun org-find-file-at-mouse (ev) "Open file link or URL at mouse." (interactive "e") @@ -9931,6 +8491,206 @@ See the docstring of `org-open-file' for details." "The window configuration before following a link. This is saved in case the need arises to restore it.") +(defun org--file-default-apps () + "Return the default applications for this operating system." + (pcase system-type + (`darwin org-file-apps-macos) + (`windows-nt org-file-apps-windowsnt) + (_ org-file-apps-gnu))) + +(defun org--file-apps-entry-dlink-p (entry) + "Non-nil if ENTRY should be matched against the link by `org-open-file'. + +It assumes that is the case when the entry uses a regular +expression which has at least one grouping construct and the +action is either a Lisp form or a command string containing +\"%1\", i.e., using at least one subexpression match as +a parameter." + (pcase entry + (`(,selector . ,action) + (and (stringp selector) + (> (regexp-opt-depth selector) 0) + (or (and (stringp action) + (string-match "%[0-9]" action)) + (consp action)))) + (_ nil))) + +(defun org--file-apps-regexp-alist (list &optional add-auto-mode) + "Convert extensions to regular expressions in the cars of LIST. + +Also, weed out any non-string entries, because the return value +is used only for regexp matching. + +When ADD-AUTO-MODE is non-nil, make all matches in `auto-mode-alist' +point to the symbol `emacs', indicating that the file should be +opened in Emacs." + (append + (delq nil + (mapcar (lambda (x) + (unless (not (stringp (car x))) + (if (string-match "\\W" (car x)) + x + (cons (concat "\\." (car x) "\\'") (cdr x))))) + list)) + (when add-auto-mode + (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) + +;;;###autoload +(defun org-open-file (path &optional in-emacs line search) + "Open the file at PATH. +First, this expands any special file name abbreviations. Then the +configuration variable `org-file-apps' is checked if it contains an +entry for this file type, and if yes, the corresponding command is launched. + +If no application is found, Emacs simply visits the file. + +With optional prefix argument IN-EMACS, Emacs will visit the file. +With a double \\[universal-argument] \\[universal-argument] \ +prefix arg, Org tries to avoid opening in Emacs +and to use an external application to visit the file. + +Optional LINE specifies a line to go to, optional SEARCH a string +to search for. If LINE or SEARCH is given, the file will be +opened in Emacs, unless an entry from `org-file-apps' that makes +use of groups in a regexp matches. + +If you want to change the way frames are used when following a +link, please customize `org-link-frame-setup'. + +If the file does not exist, throw an error." + (let* ((file (if (equal path "") buffer-file-name + (substitute-in-file-name (expand-file-name path)))) + (file-apps (append org-file-apps (org--file-default-apps))) + (apps (cl-remove-if #'org--file-apps-entry-dlink-p file-apps)) + (apps-dlink (cl-remove-if-not #'org--file-apps-entry-dlink-p + file-apps)) + (remp (and (assq 'remote apps) (file-remote-p file))) + (dirp (unless remp (file-directory-p file))) + (file (if (and dirp org-open-directory-means-index-dot-org) + (concat (file-name-as-directory file) "index.org") + file)) + (a-m-a-p (assq 'auto-mode apps)) + (dfile (downcase file)) + ;; Reconstruct the original link from the PATH, LINE and + ;; SEARCH args. + (link (cond (line (concat file "::" (number-to-string line))) + (search (concat file "::" search)) + (t file))) + (dlink (downcase link)) + (ext + (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile) + (match-string 1 dfile))) + (save-position-maybe + (let ((old-buffer (current-buffer)) + (old-pos (point)) + (old-mode major-mode)) + (lambda () + (and (derived-mode-p 'org-mode) + (eq old-mode 'org-mode) + (or (not (eq old-buffer (current-buffer))) + (not (eq old-pos (point)))) + (org-mark-ring-push old-pos old-buffer))))) + cmd link-match-data) + (cond + ((member in-emacs '((16) system)) + (setq cmd (cdr (assq 'system apps)))) + (in-emacs (setq cmd 'emacs)) + (t + (setq cmd (or (and remp (cdr (assq 'remote apps))) + (and dirp (cdr (assq 'directory apps))) + ;; First, try matching against apps-dlink if we + ;; get a match here, store the match data for + ;; later. + (let ((match (assoc-default dlink apps-dlink + 'string-match))) + (if match + (progn (setq link-match-data (match-data)) + match) + (progn (setq in-emacs (or in-emacs line search)) + nil))) ; if we have no match in apps-dlink, + ; always open the file in emacs if line or search + ; is given (for backwards compatibility) + (assoc-default dfile + (org--file-apps-regexp-alist apps a-m-a-p) + 'string-match) + (cdr (assoc ext apps)) + (cdr (assq t apps)))))) + (when (eq cmd 'system) + (setq cmd (cdr (assq 'system apps)))) + (when (eq cmd 'default) + (setq cmd (cdr (assoc t apps)))) + (when (eq cmd 'mailcap) + (require 'mailcap) + (mailcap-parse-mailcaps) + (let* ((mime-type (mailcap-extension-to-mime (or ext ""))) + (command (mailcap-mime-info mime-type))) + (if (stringp command) + (setq cmd command) + (setq cmd 'emacs)))) + (when (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files + (not (file-exists-p file)) + (not org-open-non-existing-files)) + (user-error "No such file: %s" file)) + (cond + ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) + ;; Remove quotes around the file name - we'll use shell-quote-argument. + (while (string-match "['\"]%s['\"]" cmd) + (setq cmd (replace-match "%s" t t cmd))) + (setq cmd (replace-regexp-in-string + "%s" + (shell-quote-argument (convert-standard-filename file)) + cmd + nil t)) + + ;; Replace "%1", "%2" etc. in command with group matches from regex + (save-match-data + (let ((match-index 1) + (number-of-groups (- (/ (length link-match-data) 2) 1))) + (set-match-data link-match-data) + (while (<= match-index number-of-groups) + (let ((regex (concat "%" (number-to-string match-index))) + (replace-with (match-string match-index dlink))) + (while (string-match regex cmd) + (setq cmd (replace-match replace-with t t cmd)))) + (setq match-index (+ match-index 1))))) + + (save-window-excursion + (message "Running %s...done" cmd) + (start-process-shell-command cmd nil cmd) + (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))) + ((or (stringp cmd) + (eq cmd 'emacs)) + (funcall (cdr (assq 'file org-link-frame-setup)) file) + (widen) + (cond (line (org-goto-line line) + (when (derived-mode-p 'org-mode) (org-reveal))) + (search (condition-case err + (org-link-search search) + ;; Save position before error-ing out so user + ;; can easily move back to the original buffer. + (error (funcall save-position-maybe) + (error (nth 1 err))))))) + ((functionp cmd) + (save-match-data + (set-match-data link-match-data) + (condition-case nil + (funcall cmd file link) + ;; FIXME: Remove this check when most default installations + ;; of Emacs have at least Org 9.0. + ((debug wrong-number-of-arguments wrong-type-argument + invalid-function) + (user-error "Please see Org News for version 9.0 about \ +`org-file-apps'--Lisp error: %S" cmd))))) + ((consp cmd) + ;; FIXME: Remove this check when most default installations of + ;; Emacs have at least Org 9.0. Heads-up instead of silently + ;; fall back to `org-link-frame-setup' for an old usage of + ;; `org-file-apps' with sexp instead of a function for `cmd'. + (user-error "Please see Org News for version 9.0 about \ +`org-file-apps'--Error: Deprecated usage of %S" cmd)) + (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) + (funcall save-position-maybe))) + ;;;###autoload (defun org-open-at-point-global () "Follow a link or a time-stamp like Org mode does. @@ -9942,32 +8702,16 @@ Raise a user error when there is nothing to follow." (interactive) (let ((tap-url (thing-at-point 'url)) (tap-email (thing-at-point 'email))) - (cond ((org-in-regexp org-any-link-re) - (org-open-link-from-string (match-string-no-properties 0))) + (cond ((org-in-regexp org-link-any-re) + (org-link-open-from-string (match-string-no-properties 0))) ((or (org-in-regexp org-ts-regexp-both nil t) (org-in-regexp org-tsr-regexp-both nil t)) (org-follow-timestamp-link)) - (tap-url (org-open-link-from-string tap-url)) - (tap-email (org-open-link-from-string + (tap-url (org-link-open-from-string tap-url)) + (tap-email (org-link-open-from-string (concat "mailto:" tap-email))) (t (user-error "No link found"))))) -;;;###autoload -(defun org-open-link-from-string (s &optional arg reference-buffer) - "Open a link in the string S, as if it was in Org mode." - (interactive "sLink: \nP") - (let ((reference-buffer (or reference-buffer (current-buffer)))) - (with-temp-buffer - (let ((org-inhibit-startup (not reference-buffer))) - (org-mode) - (insert s) - (goto-char (point-min)) - (when reference-buffer - (setq org-link-abbrev-alist-local - (with-current-buffer reference-buffer - org-link-abbrev-alist-local))) - (org-open-at-point arg reference-buffer))))) - (defvar org-open-at-point-functions nil "Hook that is run when following a link at point. @@ -9975,62 +8719,7 @@ Functions in this hook must return t if they identify and follow a link at point. If they don't find anything interesting at point, they must return nil.") -(defvar org-link-search-inhibit-query nil) -(defvar clean-buffer-list-kill-buffer-names) ;Defined in midnight.el -(defun org--open-doi-link (path) - "Open a \"doi\" type link. -PATH is a the path to search for, as a string." - (browse-url (url-encode-url (concat org-doi-server-url path)))) - -(defun org--open-elisp-link (path) - "Open a \"elisp\" type link. -PATH is the sexp to evaluate, as a string." - (let ((cmd path)) - (if (or (and (org-string-nw-p - org-confirm-elisp-link-not-regexp) - (string-match-p org-confirm-elisp-link-not-regexp cmd)) - (not org-confirm-elisp-link-function) - (funcall org-confirm-elisp-link-function - (format "Execute \"%s\" as elisp? " - (org-add-props cmd nil 'face 'org-warning)))) - (message "%s => %s" cmd - (if (eq (string-to-char cmd) ?\() - (eval (read cmd)) - (call-interactively (read cmd)))) - (user-error "Abort")))) - -(defun org--open-help-link (path) - "Open a \"help\" type link. -PATH is a symbol name, as a string." - (pcase (intern path) - ((and (pred fboundp) variable) (describe-function variable)) - ((and (pred boundp) function) (describe-variable function)) - (name (user-error "Unknown function or variable: %s" name)))) - -(defun org--open-shell-link (path) - "Open a \"shell\" type link. -PATH is the command to execute, as a string." - (let ((buf (generate-new-buffer "*Org Shell Output*")) - (cmd path)) - (if (or (and (org-string-nw-p - org-confirm-shell-link-not-regexp) - (string-match - org-confirm-shell-link-not-regexp cmd)) - (not org-confirm-shell-link-function) - (funcall org-confirm-shell-link-function - (format "Execute \"%s\" in shell? " - (org-add-props cmd nil - 'face 'org-warning)))) - (progn - (message "Executing %s" cmd) - (shell-command cmd buf) - (when (featurep 'midnight) - (setq clean-buffer-list-kill-buffer-names - (cons (buffer-name buf) - clean-buffer-list-kill-buffer-names)))) - (user-error "Abort")))) - -(defun org-open-at-point (&optional arg reference-buffer) +(defun org-open-at-point (&optional arg) "Open link, timestamp, footnote or tags at point. When point is on a link, follow it. Normally, files will be @@ -10050,10 +8739,6 @@ When point is on a headline, display a list of every link in the entry, so it is possible to pick one, or all, of them. If point is on a tag, call `org-tags-view' instead. -When optional argument REFERENCE-BUFFER is non-nil, it should -specify a buffer from where the link search should happen. This -is used internally by `org-open-link-from-string'. - On top of syntactically correct links, this function also tries to open links and time-stamps in comments, node properties, and keywords if point is on something looking like a timestamp or @@ -10141,73 +8826,11 @@ a link." (user-error "No link found")) ((eq type 'inline-src-block) (org-babel-open-src-block-result)) ((eq type 'timestamp) (org-follow-timestamp-link)) - ((eq type 'link) - (let ((type (org-element-property :type context)) - (path (org-element-property :path context))) - ;; Switch back to REFERENCE-BUFFER needed when called in - ;; a temporary buffer through `org-open-link-from-string'. - (with-current-buffer (or reference-buffer (current-buffer)) - (cond - ((equal type "file") - (if (string-match "[*?{]" (file-name-nondirectory path)) - (dired path) - ;; Look into `org-link-parameters' in order to find - ;; a DEDICATED-FUNCTION to open file. The function - ;; will be applied on raw link instead of parsed link - ;; due to the limitation in `org-add-link-type' - ;; ("open" function called with a single argument). - ;; If no such function is found, fallback to - ;; `org-open-file'. - (let* ((option (org-element-property :search-option context)) - (app (org-element-property :application context)) - (dedicated-function - (org-link-get-parameter - (if app (concat type "+" app) type) - :follow))) - (if dedicated-function - (funcall dedicated-function - (concat path - (and option (concat "::" option)))) - (apply #'org-open-file - path - (cond (arg) - ((equal app "emacs") 'emacs) - ((equal app "sys") 'system)) - (cond ((not option) nil) - ((string-match-p "\\`[0-9]+\\'" option) - (list (string-to-number option))) - (t (list nil option)))))))) - ((functionp (org-link-get-parameter type :follow)) - (funcall (org-link-get-parameter type :follow) path)) - ((member type '("coderef" "custom-id" "fuzzy" "radio")) - (unless (run-hook-with-args-until-success - 'org-open-link-functions path) - (if (not arg) (org-mark-ring-push) - (switch-to-buffer-other-window - (org-get-buffer-for-internal-link (current-buffer)))) - (let ((destination - (org-with-wide-buffer - (if (equal type "radio") - (org-search-radio-target - (org-element-property :path context)) - (org-link-search - (pcase type - ("custom-id" (concat "#" path)) - ("coderef" (format "(%s)" path)) - (_ path)) - ;; Prevent fuzzy links from matching - ;; themselves. - (and (equal type "fuzzy") - (+ 2 (org-element-property :begin context))))) - (point)))) - (unless (and (<= (point-min) destination) - (>= (point-max) destination)) - (widen)) - (goto-char destination)))) - (t (browse-url-at-point)))))) + ((eq type 'link) (org-link-open context arg)) (t (user-error "No link found"))))) (run-hook-with-args 'org-follow-link-hook)) +;;;###autoload (defun org-offer-links-in-entry (buffer marker &optional nth zero) "Offer links in the current entry and return the selected link. If there is only one link, return it. @@ -10219,13 +8842,13 @@ there is one, return it." (goto-char marker) (let ((cnt ?0) have-zero end links link c) - (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) + (when (and (stringp zero) (string-match org-link-bracket-re zero)) (push (match-string 0 zero) links) (setq cnt (1- cnt) have-zero t)) (save-excursion (org-back-to-heading t) (setq end (save-excursion (outline-next-heading) (point))) - (while (re-search-forward org-any-link-re end t) + (while (re-search-forward org-link-any-re end t) (push (match-string 0) links)) (setq links (org-uniquify (reverse links)))) (cond @@ -10242,7 +8865,7 @@ there is one, return it." (with-output-to-temp-buffer "*Select Link*" (dolist (l links) (cond - ((not (string-match org-bracket-link-regexp l)) + ((not (string-match org-link-bracket-re l)) (princ (format "[%c] %s\n" (cl-incf cnt) (org-unbracket-string "<" ">" l)))) ((match-end 3) @@ -10264,262 +8887,8 @@ there is one, return it." (setq link (nth (1- nth) links))))) (cons link end))))) -;; TODO: These functions are deprecated since `org-open-at-point' -;; hard-codes behavior for "file+emacs" and "file+sys" types. -(defun org-open-file-with-system (path) - "Open file at PATH using the system way of opening it." - (org-open-file path 'system)) -(defun org-open-file-with-emacs (path) - "Open file at PATH in Emacs." - (org-open-file path 'emacs)) - - ;;; File search -(defvar org-create-file-search-functions nil - "List of functions to construct the right search string for a file link. -These functions are called in turn with point at the location to -which the link should point. - -A function in the hook should first test if it would like to -handle this file type, for example by checking the `major-mode' -or the file extension. If it decides not to handle this file, it -should just return nil to give other functions a chance. If it -does handle the file, it must return the search string to be used -when following the link. The search string will be part of the -file link, given after a double colon, and `org-open-at-point' -will automatically search for it. If special measures must be -taken to make the search successful, another function should be -added to the companion hook `org-execute-file-search-functions', -which see. - -A function in this hook may also use `setq' to set the variable -`description' to provide a suggestion for the descriptive text to -be used for this link when it gets inserted into an Org buffer -with \\[org-insert-link].") - -(defvar org-execute-file-search-functions nil - "List of functions to execute a file search triggered by a link. - -Functions added to this hook must accept a single argument, the -search string that was part of the file link, the part after the -double colon. The function must first check if it would like to -handle this search, for example by checking the `major-mode' or -the file extension. If it decides not to handle this search, it -should just return nil to give other functions a chance. If it -does handle the search, it must return a non-nil value to keep -other functions from trying. - -Each function can access the current prefix argument through the -variable `current-prefix-arg'. Note that a single prefix is used -to force opening a link in Emacs, so it may be good to only use a -numeric or double prefix to guide the search function. - -In case this is needed, a function in this hook can also restore -the window configuration before `org-open-at-point' was called using: - - (set-window-configuration org-window-config-before-follow-link)") - -(defun org-search-radio-target (target) - "Search a radio target matching TARGET in current buffer. -White spaces are not significant." - (let ((re (format "<<<%s>>>" - (mapconcat #'regexp-quote - (split-string target) - "[ \t]+\\(?:\n[ \t]*\\)?"))) - (origin (point))) - (goto-char (point-min)) - (catch :radio-match - (while (re-search-forward re nil t) - (backward-char) - (let ((object (org-element-context))) - (when (eq (org-element-type object) 'radio-target) - (goto-char (org-element-property :begin object)) - (org-show-context 'link-search) - (throw :radio-match nil)))) - (goto-char origin) - (user-error "No match for radio target: %s" target)))) - -(defun org-link-search (s &optional avoid-pos stealth) - "Search for a search string S. - -If S starts with \"#\", it triggers a custom ID search. - -If S is enclosed within parenthesis, it initiates a coderef -search. - -If S is surrounded by forward slashes, it is interpreted as -a regular expression. In Org mode files, this will create an -`org-occur' sparse tree. In ordinary files, `occur' will be used -to list matches. If the current buffer is in `dired-mode', grep -will be used to search in all files. - -When AVOID-POS is given, ignore matches near that position. - -When optional argument STEALTH is non-nil, do not modify -visibility around point, thus ignoring `org-show-context-detail' -variable. - -Search is case-insensitive and ignores white spaces. Return type -of matched result, which is either `dedicated' or `fuzzy'." - (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s)) - (let* ((case-fold-search t) - (origin (point)) - (normalized (replace-regexp-in-string "\n[ \t]*" " " s)) - (starred (eq (string-to-char normalized) ?*)) - (words (split-string (if starred (substring s 1) s))) - (s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)")) - (s-single-re (mapconcat #'regexp-quote words "[ \t]+")) - type) - (cond - ;; Check if there are any special search functions. - ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) - ((eq (string-to-char s) ?#) - ;; Look for a custom ID S if S starts with "#". - (let* ((id (substring normalized 1)) - (match (org-find-property "CUSTOM_ID" id))) - (if match (progn (goto-char match) (setf type 'dedicated)) - (error "No match for custom ID: %s" id)))) - ((string-match "\\`(\\(.*\\))\\'" normalized) - ;; Look for coderef targets if S is enclosed within parenthesis. - (let ((coderef (match-string-no-properties 1 normalized)) - (re (substring s-single-re 1 -1))) - (goto-char (point-min)) - (catch :coderef-match - (while (re-search-forward re nil t) - (let ((element (org-element-at-point))) - (when (and (memq (org-element-type element) - '(example-block src-block)) - (org-match-line - (concat ".*?" (org-src-coderef-regexp - (org-src-coderef-format element) - coderef)))) - (setq type 'dedicated) - (goto-char (match-beginning 2)) - (throw :coderef-match nil)))) - (goto-char origin) - (error "No match for coderef: %s" coderef)))) - ((string-match "\\`/\\(.*\\)/\\'" normalized) - ;; Look for a regular expression. - (funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur) - (match-string 1 s))) - ;; From here, we handle fuzzy links. - ;; - ;; Look for targets, only if not in a headline search. - ((and (not starred) - (let ((target (format "<<%s>>" s-multi-re))) - (catch :target-match - (goto-char (point-min)) - (while (re-search-forward target nil t) - (backward-char) - (let ((context (org-element-context))) - (when (eq (org-element-type context) 'target) - (setq type 'dedicated) - (goto-char (org-element-property :begin context)) - (throw :target-match t)))) - nil)))) - ;; Look for elements named after S, only if not in a headline - ;; search. - ((and (not starred) - (let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re))) - (catch :name-match - (goto-char (point-min)) - (while (re-search-forward name nil t) - (let ((element (org-element-at-point))) - (when (equal words - (split-string - (org-element-property :name element))) - (setq type 'dedicated) - (beginning-of-line) - (throw :name-match t)))) - nil)))) - ;; Regular text search. Prefer headlines in Org mode buffers. - ;; Ignore COMMENT keyword, TODO keywords, priority cookies, - ;; statistics cookies and tags. - ((and (derived-mode-p 'org-mode) - (let ((title-re - (format "%s.*\\(?:%s[ \t]\\)?.*%s" - org-outline-regexp-bol - org-comment-string - (mapconcat #'regexp-quote words ".+"))) - (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]") - (comment-re (eval-when-compile - (format "\\`%s[ \t]+" org-comment-string)))) - (goto-char (point-min)) - (catch :found - (while (re-search-forward title-re nil t) - (when (equal words - (split-string - (replace-regexp-in-string - cookie-re "" - (replace-regexp-in-string - comment-re "" (org-get-heading t t t))))) - (throw :found t))) - nil))) - (beginning-of-line) - (setq type 'dedicated)) - ;; Offer to create non-existent headline depending on - ;; `org-link-search-must-match-exact-headline'. - ((and (derived-mode-p 'org-mode) - (not org-link-search-inhibit-query) - (eq org-link-search-must-match-exact-headline 'query-to-create) - (yes-or-no-p "No match - create this as a new heading? ")) - (goto-char (point-max)) - (unless (bolp) (newline)) - (org-insert-heading nil t t) - (insert s "\n") - (beginning-of-line 0)) - ;; Only headlines are looked after. No need to process - ;; further: throw an error. - ((and (derived-mode-p 'org-mode) - (or starred org-link-search-must-match-exact-headline)) - (goto-char origin) - (error "No match for fuzzy expression: %s" normalized)) - ;; Regular text search. - ((catch :fuzzy-match - (goto-char (point-min)) - (while (re-search-forward s-multi-re nil t) - ;; Skip match if it contains AVOID-POS or it is included in - ;; a link with a description but outside the description. - (unless (or (and avoid-pos - (<= (match-beginning 0) avoid-pos) - (> (match-end 0) avoid-pos)) - (and (save-match-data - (org-in-regexp org-bracket-link-regexp)) - (match-beginning 3) - (or (> (match-beginning 3) (point)) - (<= (match-end 3) (point))) - (org-element-lineage - (save-match-data (org-element-context)) - '(link) t))) - (goto-char (match-beginning 0)) - (setq type 'fuzzy) - (throw :fuzzy-match t))) - nil)) - ;; All failed. Throw an error. - (t (goto-char origin) - (error "No match for fuzzy expression: %s" normalized))) - ;; Disclose surroundings of match, if appropriate. - (when (and (derived-mode-p 'org-mode) (not stealth)) - (org-show-context 'link-search)) - type)) - -(defun org-get-buffer-for-internal-link (buffer) - "Return a buffer to be used for displaying the link target of internal links." - (cond - ((not org-display-internal-link-with-indirect-buffer) - buffer) - ((string-suffix-p "(Clone)" (buffer-name buffer)) - (message "Buffer is already a clone, not making another one") - ;; we also do not modify visibility in this case - buffer) - (t ; make a new indirect buffer for displaying the link - (let* ((bn (buffer-name buffer)) - (ibn (concat bn "(Clone)")) - (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone)))) - (with-current-buffer ib (org-overview)) - ib)))) - (defun org-do-occur (regexp &optional cleanup) "Call the Emacs command `occur'. If CLEANUP is non-nil, remove the printout of the regular expression @@ -10588,11 +8957,6 @@ or to another Org file, automatically push the old position onto the ring." (goto-char m) (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) -(defun org-add-angle-brackets (s) - (unless (equal (substring s 0 1) "<") (setq s (concat "<" s))) - (unless (equal (substring s -1) ">") (setq s (concat s ">"))) - s) - ;;; Following specific links (defvar org-agenda-buffer-tmp-name) @@ -10625,208 +8989,6 @@ or to another Org file, automatically push the old position onto the ring." (declare-function mailcap-mime-info "mailcap" (string &optional request no-decode)) (defvar org-wait nil) -(defun org-open-file (path &optional in-emacs line search) - "Open the file at PATH. -First, this expands any special file name abbreviations. Then the -configuration variable `org-file-apps' is checked if it contains an -entry for this file type, and if yes, the corresponding command is launched. - -If no application is found, Emacs simply visits the file. - -With optional prefix argument IN-EMACS, Emacs will visit the file. -With a double \\[universal-argument] \\[universal-argument] \ -prefix arg, Org tries to avoid opening in Emacs -and to use an external application to visit the file. - -Optional LINE specifies a line to go to, optional SEARCH a string -to search for. If LINE or SEARCH is given, the file will be -opened in Emacs, unless an entry from org-file-apps that makes -use of groups in a regexp matches. - -If you want to change the way frames are used when following a -link, please customize `org-link-frame-setup'. - -If the file does not exist, an error is thrown." - (let* ((file (if (equal path "") - buffer-file-name - (substitute-in-file-name (expand-file-name path)))) - (file-apps (append org-file-apps (org-default-apps))) - (apps (cl-remove-if - 'org-file-apps-entry-match-against-dlink-p file-apps)) - (apps-dlink (cl-remove-if-not - 'org-file-apps-entry-match-against-dlink-p file-apps)) - (remp (and (assq 'remote apps) (file-remote-p file))) - (dirp (unless remp (file-directory-p file))) - (file (if (and dirp org-open-directory-means-index-dot-org) - (concat (file-name-as-directory file) "index.org") - file)) - (a-m-a-p (assq 'auto-mode apps)) - (dfile (downcase file)) - ;; Reconstruct the original link from the PATH, LINE and - ;; SEARCH args. - (link (cond (line (concat file "::" (number-to-string line))) - (search (concat file "::" search)) - (t file))) - (dlink (downcase link)) - (ext - (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile) - (match-string 1 dfile))) - (save-position-maybe - (let ((old-buffer (current-buffer)) - (old-pos (point)) - (old-mode major-mode)) - (lambda () - (and (derived-mode-p 'org-mode) - (eq old-mode 'org-mode) - (or (not (eq old-buffer (current-buffer))) - (not (eq old-pos (point)))) - (org-mark-ring-push old-pos old-buffer))))) - cmd link-match-data) - (cond - ((member in-emacs '((16) system)) - (setq cmd (cdr (assq 'system apps)))) - (in-emacs (setq cmd 'emacs)) - (t - (setq cmd (or (and remp (cdr (assq 'remote apps))) - (and dirp (cdr (assq 'directory apps))) - ;; First, try matching against apps-dlink if we - ;; get a match here, store the match data for - ;; later. - (let ((match (assoc-default dlink apps-dlink - 'string-match))) - (if match - (progn (setq link-match-data (match-data)) - match) - (progn (setq in-emacs (or in-emacs line search)) - nil))) ; if we have no match in apps-dlink, - ; always open the file in emacs if line or search - ; is given (for backwards compatibility) - (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) - 'string-match) - (cdr (assoc ext apps)) - (cdr (assq t apps)))))) - (when (eq cmd 'system) - (setq cmd (cdr (assq 'system apps)))) - (when (eq cmd 'default) - (setq cmd (cdr (assoc t apps)))) - (when (eq cmd 'mailcap) - (require 'mailcap) - (mailcap-parse-mailcaps) - (let* ((mime-type (mailcap-extension-to-mime (or ext ""))) - (command (mailcap-mime-info mime-type))) - (if (stringp command) - (setq cmd command) - (setq cmd 'emacs)))) - (when (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files - (not (file-exists-p file)) - (not org-open-non-existing-files)) - (user-error "No such file: %s" file)) - (cond - ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) - ;; Remove quotes around the file name - we'll use shell-quote-argument. - (while (string-match "['\"]%s['\"]" cmd) - (setq cmd (replace-match "%s" t t cmd))) - (setq cmd (replace-regexp-in-string - "%s" - (shell-quote-argument (convert-standard-filename file)) - cmd - nil t)) - - ;; Replace "%1", "%2" etc. in command with group matches from regex - (save-match-data - (let ((match-index 1) - (number-of-groups (- (/ (length link-match-data) 2) 1))) - (set-match-data link-match-data) - (while (<= match-index number-of-groups) - (let ((regex (concat "%" (number-to-string match-index))) - (replace-with (match-string match-index dlink))) - (while (string-match regex cmd) - (setq cmd (replace-match replace-with t t cmd)))) - (setq match-index (+ match-index 1))))) - - (save-window-excursion - (message "Running %s...done" cmd) - (start-process-shell-command cmd nil cmd) - (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))) - ((or (stringp cmd) - (eq cmd 'emacs)) - (funcall (cdr (assq 'file org-link-frame-setup)) file) - (widen) - (cond (line (org-goto-line line) - (when (derived-mode-p 'org-mode) (org-reveal))) - (search (condition-case err - (org-link-search search) - ;; Save position before error-ing out so user - ;; can easily move back to the original buffer. - (error (funcall save-position-maybe) - (error (nth 1 err))))))) - ((functionp cmd) - (save-match-data - (set-match-data link-match-data) - (condition-case nil - (funcall cmd file link) - ;; FIXME: Remove this check when most default installations - ;; of Emacs have at least Org 9.0. - ((debug wrong-number-of-arguments wrong-type-argument - invalid-function) - (user-error "Please see Org News for version 9.0 about \ -`org-file-apps'--Lisp error: %S" cmd))))) - ((consp cmd) - ;; FIXME: Remove this check when most default installations of - ;; Emacs have at least Org 9.0. Heads-up instead of silently - ;; fall back to `org-link-frame-setup' for an old usage of - ;; `org-file-apps' with sexp instead of a function for `cmd'. - (user-error "Please see Org News for version 9.0 about \ -`org-file-apps'--Error: Deprecated usage of %S" cmd)) - (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) - (funcall save-position-maybe))) - -(defun org-file-apps-entry-match-against-dlink-p (entry) - "This function returns non-nil if `entry' uses a regular -expression which should be matched against the whole link by -org-open-file. - -It assumes that is the case when the entry uses a regular -expression which has at least one grouping construct and the -action is either a lisp form or a command string containing -`%1', i.e. using at least one subexpression match as a -parameter." - (let ((selector (car entry)) - (action (cdr entry))) - (if (stringp selector) - (and (> (regexp-opt-depth selector) 0) - (or (and (stringp action) - (string-match "%[0-9]" action)) - (consp action))) - nil))) - -(defun org-default-apps () - "Return the default applications for this operating system." - (cond - ((eq system-type 'darwin) - org-file-apps-defaults-macosx) - ((eq system-type 'windows-nt) - org-file-apps-defaults-windowsnt) - (t org-file-apps-defaults-gnu))) - -(defun org-apps-regexp-alist (list &optional add-auto-mode) - "Convert extensions to regular expressions in the cars of LIST. -Also, weed out any non-string entries, because the return value is used -only for regexp matching. -When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist' -point to the symbol `emacs', indicating that the file should -be opened in Emacs." - (append - (delq nil - (mapcar (lambda (x) - (unless (not (stringp (car x))) - (if (string-match "\\W" (car x)) - x - (cons (concat "\\." (car x) "\\'") (cdr x))))) - list)) - (when add-auto-mode - (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) - ;;;; Refiling @@ -11227,7 +9389,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." (org-back-to-heading t) (setq heading-text (replace-regexp-in-string - org-bracket-link-regexp + org-link-bracket-re "\\3" (or (nth 4 (org-heading-components)) "")))) @@ -18630,8 +16792,8 @@ boundaries." (org-with-point-at inner-start (and (looking-at (if (char-equal ?< (char-after inner-start)) - org-angle-link-re - org-plain-link-re)) + org-link-angle-re + org-link-plain-re)) ;; File name must fill the whole ;; description. (= (org-element-property :contents-end link) @@ -19601,7 +17763,7 @@ Otherwise, return a user error." (match-string 0 value))))) (when (org-file-url-p file) (user-error "Files located with a URL cannot be edited")) - (org-open-link-from-string + (org-link-open-from-string (format "[[%s]]" (expand-file-name file)))))) (`table (if (eq (org-element-property :type element) 'table.el) @@ -19972,7 +18134,7 @@ object (e.g., within a comment). In these case, you need to use (> (point) origin)))) (org-in-regexp org-ts-regexp-both nil t) (org-in-regexp org-tsr-regexp-both nil t) - (org-in-regexp org-any-link-re nil t))) + (org-in-regexp org-link-any-re nil t))) (call-interactively #'org-open-at-point)) ;; Insert newline in heading, but preserve tags. ((and (not (bolp)) @@ -20614,26 +18776,6 @@ With prefix arg UNCOMPILED, load the uncompiled versions." ;;; Generally useful functions -(defun org-link-display-format (s) - "Replace links in string S with their description. -If there is no description, use the link target." - (save-match-data - (replace-regexp-in-string - org-bracket-link-analytic-regexp - (lambda (m) - (if (match-end 5) (match-string 5 m) - (concat (match-string 1 m) (match-string 3 m)))) - s nil t))) - -(defun org-toggle-link-display () - "Toggle the literal or descriptive display of links." - (interactive) - (if org-descriptive-links - (remove-from-invisibility-spec '(org-link)) - (add-to-invisibility-spec '(org-link))) - (org-restart-font-lock) - (setq org-descriptive-links (not org-descriptive-links))) - (defun org-in-clocktable-p () "Check if the cursor is in a clocktable." (let ((pos (point)) start) @@ -20731,8 +18873,6 @@ contexts are: :src-block in a source block :link on a hyperlink :keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT. -:target on a <<target>> -:radio-target on a <<<radio-target>>> :latex-fragment on a LaTeX fragment :latex-preview on a LaTeX fragment with overlaid preview image @@ -20806,12 +18946,6 @@ and :keyword." (push (list :keyword (previous-single-property-change p 'face) (next-single-property-change p 'face)) clist)) - ((org-at-target-p) - (push (org-point-in-group p 0 :target) clist) - (goto-char (1- (match-beginning 0))) - (when (looking-at org-radio-target-regexp) - (push (org-point-in-group p 0 :radio-target) clist)) - (goto-char p)) ((setq o (cl-some (lambda (o) (and (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay) @@ -22502,10 +20636,6 @@ empty." (defun org-at-heading-or-item-p () (or (org-at-heading-p) (org-at-item-p))) -(defun org-at-target-p () - (or (org-in-regexp org-radio-target-regexp) - (org-in-regexp org-target-regexp))) - (defun org-up-heading-all (arg) "Move to the heading line of which the present line is a subheading. This function considers both visible and invisible heading lines. @@ -73,6 +73,7 @@ (require 'cl-lib) (require 'ob-exp) +(require 'ol) (require 'org-element) (require 'org-macro) (require 'tabulated-list) @@ -3531,8 +3532,8 @@ is to happen." (goto-char (point-min)) (unless (eq major-mode 'org-mode) (let ((org-inhibit-startup t)) (org-mode))) ;set regexps - (let ((regexp (concat org-plain-link-re "\\|" org-angle-link-re))) - (while (re-search-forward org-any-link-re nil t) + (let ((regexp (concat org-link-plain-re "\\|" org-link-angle-re))) + (while (re-search-forward org-link-any-re nil t) (let ((link (save-excursion (forward-char -1) (save-match-data (org-element-context))))) @@ -4257,8 +4258,8 @@ structure of RULES. Return modified DATA." (let ((link-re (format "\\`\\(?:%s\\|%s\\)\\'" - org-plain-link-re - org-angle-link-re)) + org-link-plain-re + org-link-angle-re)) (case-fold-search t)) (org-element-map data 'link (lambda (l) |