config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

ol.el (88895B)


      1 ;;; ol.el --- Org links library                      -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2018-2024 Free Software Foundation, Inc.
      4 
      5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
      6 ;; Keywords: outlines, hypermedia, calendar, text
      7 
      8 ;; This file is part of GNU Emacs.
      9 
     10 ;; GNU Emacs is free software; you can redistribute it and/or modify
     11 ;; it under the terms of the GNU General Public License as published by
     12 ;; the Free Software Foundation, either version 3 of the License, or
     13 ;; (at your option) any later version.
     14 
     15 ;; GNU Emacs is distributed in the hope that it will be useful,
     16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     18 ;; GNU General Public License for more details.
     19 
     20 ;; You should have received a copy of the GNU General Public License
     21 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     22 
     23 ;;; Commentary:
     24 
     25 ;; This library provides tooling to handle both external and internal
     26 ;; links.
     27 
     28 ;;; Code:
     29 
     30 (require 'org-macs)
     31 (org-assert-version)
     32 
     33 (require 'org-compat)
     34 (require 'org-macs)
     35 (require 'org-fold)
     36 
     37 (defvar clean-buffer-list-kill-buffer-names)
     38 (defvar org-agenda-buffer-name)
     39 (defvar org-comment-string)
     40 (defvar org-highlight-links)
     41 (defvar org-id-link-to-org-use-id)
     42 (defvar org-inhibit-startup)
     43 (defvar org-outline-regexp-bol)
     44 (defvar org-src-source-file-name)
     45 (defvar org-ts-regexp)
     46 
     47 (declare-function calendar-cursor-to-date "calendar" (&optional error event))
     48 (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
     49 (declare-function org-at-heading-p "org" (&optional _))
     50 (declare-function org-back-to-heading "org" (&optional invisible-ok))
     51 (declare-function org-before-first-heading-p "org" ())
     52 (declare-function org-do-occur "org" (regexp &optional cleanup))
     53 (declare-function org-element-at-point "org-element" (&optional pom cached-only))
     54 (declare-function org-element-cache-refresh "org-element" (pos))
     55 (declare-function org-element-cache-reset "org-element" (&optional all no-persistence))
     56 (declare-function org-element-context "org-element" (&optional element))
     57 (declare-function org-element-lineage "org-element-ast" (datum &optional types with-self))
     58 (declare-function org-element-link-parser "org-element" ())
     59 (declare-function org-element-property "org-element-ast" (property node))
     60 (declare-function org-element-begin "org-element" (node))
     61 (declare-function org-element-end "org-element" (node))
     62 (declare-function org-element-type-p "org-element-ast" (node types))
     63 (declare-function org-element-update-syntax "org-element" ())
     64 (declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
     65 (declare-function org-find-property "org" (property &optional value))
     66 (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
     67 (declare-function org-id-find-id-file "org-id" (id))
     68 (declare-function org-insert-heading "org" (&optional arg invisible-ok top))
     69 (declare-function org-load-modules-maybe "org" (&optional force))
     70 (declare-function org-mark-ring-push "org" (&optional pos buffer))
     71 (declare-function org-mode "org" ())
     72 (declare-function org-occur "org" (regexp &optional keep-previous callback))
     73 (declare-function org-open-file "org" (path &optional in-emacs line search))
     74 (declare-function org-cycle-overview "org-cycle" ())
     75 (declare-function org-restart-font-lock "org" ())
     76 (declare-function org-run-like-in-org-mode "org" (cmd))
     77 (declare-function org-fold-show-context "org-fold" (&optional key))
     78 (declare-function org-src-coderef-format "org-src" (&optional element))
     79 (declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
     80 (declare-function org-src-edit-buffer-p "org-src" (&optional buffer))
     81 (declare-function org-src-source-buffer "org-src" ())
     82 (declare-function org-src-source-type "org-src" ())
     83 (declare-function org-time-stamp-format "org" (&optional long inactive))
     84 (declare-function outline-next-heading "outline" ())
     85 
     86 
     87 ;;; Customization
     88 
     89 (defgroup org-link nil
     90   "Options concerning links in Org mode."
     91   :tag "Org Link"
     92   :group 'org)
     93 
     94 (defcustom org-link-parameters nil
     95   "Alist of properties that defines all the links in Org mode.
     96 
     97 The key in each association is a string of the link type.
     98 Subsequent optional elements make up a property list for that
     99 type.
    100 
    101 All properties are optional.  However, the most important ones
    102 are, in this order, `:follow', `:export', and `:store', described
    103 below.
    104 
    105 `:follow'
    106 
    107   Function used to follow the link, when the `org-open-at-point'
    108   command runs on it.  It is called with two arguments: the path,
    109   as a string, and a universal prefix argument.
    110 
    111   Here, you may use `org-link-open-as-file' helper function for
    112   types similar to \"file\".
    113 
    114 `:export'
    115 
    116   Function that accepts four arguments:
    117   - the path, as a string,
    118   - the description as a string, or nil,
    119   - the export backend,
    120   - the export communication channel, as a plist.
    121 
    122   When nil, export for that type of link is delegated to the
    123   backend.
    124 
    125 `:store'
    126 
    127   Function responsible for storing the link.  See the function
    128   `org-store-link-functions' for a description of the expected
    129   arguments.
    130 
    131 Additional properties provide more specific control over the
    132 link.
    133 
    134 `:activate-func'
    135 
    136   Function to run at the end of Font Lock activation.  It must
    137   accept four arguments:
    138   - the buffer position at the start of the link,
    139   - the buffer position at its end,
    140   - the path, as a string,
    141   - a boolean, non-nil when the link has brackets.
    142 
    143 `:complete'
    144 
    145   Function that inserts a link with completion.  The function
    146   takes one optional prefix argument.
    147 
    148 `:insert-description'
    149 
    150   String or function used as a default when prompting users for a
    151   link's description.  A string is used as-is, a function is
    152   called with two arguments: the link location (a string such as
    153   \"~/foobar\", \"id:some-org-id\" or \"https://www.foo.com\")
    154   and the description generated by `org-insert-link'.  It should
    155   return the description to use (this reflects the behavior of
    156   `org-link-make-description-function').  If it returns nil, no
    157   default description is used, but no error is thrown (from the
    158   user's perspective, this is equivalent to a default description
    159   of \"\").
    160 
    161 `:display'
    162 
    163   Value for `invisible' text property on the hidden parts of the
    164   link.  The most useful value is `full', which will not fold the
    165   link in descriptive display.  Default is `org-link'.
    166 
    167 `:face'
    168 
    169   Face for the link, or a function returning a face.  The
    170   function takes one argument, which is the path.
    171 
    172   The default face is `org-link'.
    173 
    174 `:help-echo'
    175 
    176   String or function used as a value for the `help-echo' text
    177   property.  The function is called with one argument, the help
    178   string to display, and should return a string.
    179 
    180 `:htmlize-link'
    181 
    182   Function or plist for the `htmlize-link' text property.  The
    183   function takes no argument.
    184 
    185   Default is (:uri \"type:path\")
    186 
    187 `:keymap'
    188 
    189   Active keymap when point is on the link.  Default is
    190   `org-mouse-map'.
    191 
    192 `:mouse-face'
    193 
    194   Face used when hovering over the link.  Default is
    195   `highlight'."
    196   :group 'org-link
    197   :package-version '(Org . "9.1")
    198   :type '(alist :tag "Link display parameters"
    199 		:value-type plist))
    200 
    201 (defun org-link--set-link-display (symbol value)
    202   "Set `org-link-descriptive' (SYMBOL) to VALUE.
    203 Also, ensure that links are updated in current buffer.
    204 
    205 This function is intended to be used as a :set function."
    206   (set symbol value)
    207   (dolist (buf (org-buffer-list))
    208     (with-current-buffer buf
    209       (org-restart-font-lock))))
    210 
    211 (defcustom org-link-descriptive t
    212   "Non-nil means Org displays descriptive links.
    213 
    214 E.g. [[https://orgmode.org][Org website]] is displayed as
    215 \"Org Website\", hiding the link itself and just displaying its
    216 description.  When set to nil, Org displays the full links
    217 literally.
    218 
    219 You can interactively set the value of this variable by calling
    220 `org-toggle-link-display' or from the \"Org > Hyperlinks\" menu."
    221   :group 'org-link
    222   :set #'org-link--set-link-display
    223   :type 'boolean
    224   :safe #'booleanp)
    225 
    226 (defcustom org-link-make-description-function nil
    227   "Function to use for generating link descriptions from links.
    228 This function must take two parameters: the first one is the
    229 link, the second one is the description generated by
    230 `org-insert-link'.  The function should return the description to
    231 use.  If it returns nil, no default description is used, but no
    232 error is thrown (from the user’s perspective, this is equivalent
    233 to a default description of \"\")."
    234   :group 'org-link
    235   :type '(choice (const nil) (function))
    236   :safe #'null)
    237 
    238 (defcustom org-link-file-path-type 'adaptive
    239   "How the path name in file links should be stored.
    240 Valid values are:
    241 
    242 relative  Relative to the current directory, i.e. the directory of the file
    243           into which the link is being inserted.
    244 absolute  Absolute path, if possible with ~ for home directory.
    245 noabbrev  Absolute path, no abbreviation of home directory.
    246 adaptive  Use relative path for files in the current directory and sub-
    247           directories of it.  For other files, use an absolute path.
    248 
    249 Alternatively, users may supply a custom function that takes the
    250 filename in the link as an argument and returns the path."
    251   :group 'org-link
    252   :type '(choice
    253 	  (const relative)
    254 	  (const absolute)
    255 	  (const noabbrev)
    256 	  (const adaptive)
    257 	  (function))
    258   :package-version '(Org . "9.5")
    259   :safe #'symbolp)
    260 
    261 (defcustom org-link-abbrev-alist nil
    262   "Alist of link abbreviations.
    263 The car of each element is a string, to be replaced at the start of a link.
    264 The cdrs are replacement values, like (\"linkkey\" . REPLACE).  Abbreviated
    265 links in Org buffers can have an optional tag after a double colon, e.g.,
    266 
    267      [[linkkey:tag][description]]
    268 
    269 The `linkkey' must be a single word, starting with a letter, followed
    270 by letters, numbers, `-' or `_'.
    271 
    272 If REPLACE is a string, the tag will simply be appended to create the link.
    273 If the string contains \"%s\", the tag will be inserted there.  If the string
    274 contains \"%h\", it will cause a url-encoded version of the tag to be inserted
    275 at that point (see the function `url-hexify-string').  If the string contains
    276 the specifier \"%(my-function)\", then the custom function `my-function' will
    277 be invoked: this function takes the tag as its only argument and must return
    278 a string.
    279 
    280 REPLACE may also be a function that will be called with the tag as the
    281 only argument to create the link, which should be returned as a string.
    282 
    283 See the manual for examples."
    284   :group 'org-link
    285   :type '(repeat
    286 	  (cons (string :tag "Protocol")
    287 		(choice
    288 		 (string :tag "Format")
    289 		 (function))))
    290   :safe (lambda (alist)
    291           (when (listp alist)
    292             (catch :unsafe
    293               (dolist (val alist)
    294 	        (pcase val
    295 	          (`(,(pred stringp) . ,(pred stringp)) t)
    296 	          (_ (throw :unsafe nil))))
    297               t))))
    298 
    299 (defgroup org-link-follow nil
    300   "Options concerning following links in Org mode."
    301   :tag "Org Follow Link"
    302   :group 'org-link)
    303 
    304 (defcustom org-link-translation-function nil
    305   "Function to translate links with different syntax to Org syntax.
    306 This can be used to translate links created for example by the Planner
    307 or emacs-wiki packages to Org syntax.
    308 The function must accept two parameters, a TYPE containing the link
    309 protocol name like \"rmail\" or \"gnus\" as a string, and the linked path,
    310 which is everything after the link protocol.  It should return a cons
    311 with possibly modified values of type and path."
    312   :group 'org-link-follow
    313   :type '(choice (const nil) (function))
    314   :safe #'null)
    315 
    316 (defcustom org-link-frame-setup
    317   '((vm . vm-visit-folder-other-frame)
    318     (vm-imap . vm-visit-imap-folder-other-frame)
    319     (gnus . org-gnus-no-new-news)
    320     (file . find-file-other-window)
    321     (wl . wl-other-frame))
    322   "Setup the frame configuration for following links.
    323 When following a link with Emacs, it may often be useful to display
    324 this link in another window or frame.  This variable can be used to
    325 set this up for the different types of links.
    326 For VM, use any of
    327     `vm-visit-folder'
    328     `vm-visit-folder-other-window'
    329     `vm-visit-folder-other-frame'
    330 For Gnus, use any of
    331     `gnus'
    332     `gnus-other-frame'
    333     `org-gnus-no-new-news'
    334 For FILE, use any of
    335     `find-file'
    336     `find-file-other-window'
    337     `find-file-other-frame'
    338 For Wanderlust use any of
    339     `wl'
    340     `wl-other-frame'
    341 For the calendar, use the variable `calendar-setup'.
    342 For BBDB, it is currently only possible to display the matches in
    343 another window."
    344   :group 'org-link-follow
    345   :type '(list
    346 	  (cons (const vm)
    347 		(choice
    348 		 (const vm-visit-folder)
    349 		 (const vm-visit-folder-other-window)
    350 		 (const vm-visit-folder-other-frame)))
    351 	  (cons (const vm-imap)
    352 		(choice
    353 		 (const vm-visit-imap-folder)
    354 		 (const vm-visit-imap-folder-other-window)
    355 		 (const vm-visit-imap-folder-other-frame)))
    356 	  (cons (const gnus)
    357 		(choice
    358 		 (const gnus)
    359 		 (const gnus-other-frame)
    360 		 (const org-gnus-no-new-news)))
    361 	  (cons (const file)
    362 		(choice
    363 		 (const find-file)
    364 		 (const find-file-other-window)
    365 		 (const find-file-other-frame)))
    366 	  (cons (const wl)
    367 		(choice
    368 		 (const wl)
    369 		 (const wl-other-frame)))))
    370 
    371 (defcustom org-link-search-must-match-exact-headline 'query-to-create
    372   "Control fuzzy link behavior when specific matches not found.
    373 
    374 When nil, if a fuzzy link does not match a more specific
    375 target (such as a heading, named block, target, or code ref),
    376 attempt a regular text search.  When set to the special value
    377 `query-to-create', offer to create a new heading matching the
    378 link instead.  Otherwise, signal an error rather than attempting
    379 a regular text search.
    380 
    381 This option only affects behavior in Org buffers.  Spaces and
    382 statistics cookies are ignored during heading searches."
    383   :group 'org-link-follow
    384   :version "24.1"
    385   :type '(choice
    386 	  (const :tag "Use fuzzy text search" nil)
    387 	  (const :tag "Match only exact headline" t)
    388 	  (const :tag "Match exact headline or query to create it"
    389 		 query-to-create))
    390   :safe #'symbolp)
    391 
    392 (defcustom org-link-use-indirect-buffer-for-internals nil
    393   "Non-nil means use indirect buffer to display infile links.
    394 Activating internal links (from one location in a file to another location
    395 in the same file) normally just jumps to the location.  When the link is
    396 activated with a `\\[universal-argument]' prefix (or with mouse-3), the link \
    397 is displayed in
    398 another window.  When this option is set, the other window actually displays
    399 an indirect buffer clone of the current buffer, to avoid any visibility
    400 changes to the current buffer."
    401   :group 'org-link-follow
    402   :type 'boolean
    403   :safe #'booleanp)
    404 
    405 (defcustom org-link-shell-confirm-function 'yes-or-no-p
    406   "Non-nil means ask for confirmation before executing shell links.
    407 
    408 Shell links can be dangerous: just think about a link
    409 
    410      [[shell:rm -rf ~/*][Web Search]]
    411 
    412 This link would show up in your Org document as \"Web Search\",
    413 but really it would remove your entire home directory.
    414 Therefore we advise against setting this variable to nil.
    415 Just change it to `y-or-n-p' if you want to confirm with a
    416 single keystroke rather than having to type \"yes\"."
    417   :group 'org-link-follow
    418   :type '(choice
    419 	  (const :tag "with yes-or-no (safer)" yes-or-no-p)
    420 	  (const :tag "with y-or-n (faster)" y-or-n-p)
    421 	  (const :tag "no confirmation (dangerous)" nil)))
    422 
    423 (defcustom org-link-shell-skip-confirm-regexp ""
    424   "Regexp to skip confirmation for shell links."
    425   :group 'org-link-follow
    426   :version "24.1"
    427   :type 'regexp)
    428 
    429 (defcustom org-link-elisp-confirm-function 'yes-or-no-p
    430   "Non-nil means ask for confirmation before executing Emacs Lisp links.
    431 Elisp links can be dangerous: just think about a link
    432 
    433      [[elisp:(shell-command \"rm -rf ~/*\")][Web Search]]
    434 
    435 This link would show up in your Org document as \"Web Search\",
    436 but really it would remove your entire home directory.
    437 Therefore we advise against setting this variable to nil.
    438 Just change it to `y-or-n-p' if you want to confirm with a
    439 single keystroke rather than having to type \"yes\"."
    440   :group 'org-link-follow
    441   :type '(choice
    442 	  (const :tag "with yes-or-no (safer)" yes-or-no-p)
    443 	  (const :tag "with y-or-n (faster)" y-or-n-p)
    444 	  (const :tag "no confirmation (dangerous)" nil)))
    445 
    446 (defcustom org-link-elisp-skip-confirm-regexp ""
    447   "A regexp to skip confirmation for Elisp links."
    448   :group 'org-link-follow
    449   :version "24.1"
    450   :type 'regexp)
    451 
    452 (defgroup org-link-store nil
    453   "Options concerning storing links in Org mode."
    454   :tag "Org Store Link"
    455   :group 'org-link)
    456 
    457 (defcustom org-link-context-for-files t
    458   "Non-nil means file links from `org-store-link' contain context.
    459 \\<org-mode-map>
    460 A search string is added to the file name with \"::\" as separator
    461 and used to find the context when the link is activated by the command
    462 `org-open-at-point'.  When this option is t, the entire active region
    463 is be placed in the search string of the file link.  If set to a
    464 positive integer N, only the first N lines of context are stored.
    465 
    466 Using a prefix argument to the command `org-store-link' \
    467 \(`\\[universal-argument] \\[org-store-link]')
    468 negates this setting for the duration of the command."
    469   :group 'org-link-store
    470   :type '(choice boolean integer)
    471   :safe (lambda (val) (or (booleanp val) (integerp val))))
    472 
    473 (defcustom org-link-email-description-format "Email %c: %s"
    474   "Format of the description part of a link to an email or Usenet message.
    475 The following %-escapes will be replaced by corresponding information:
    476 
    477 %F   full \"From\" field
    478 %f   name, taken from \"From\" field, address if no name
    479 %T   full \"To\" field
    480 %t   first name in \"To\" field, address if no name
    481 %c   correspondent.  Usually \"from NAME\", but if you sent it yourself, it
    482      will be \"to NAME\".  See also the variable `org-from-is-user-regexp'.
    483 %s   subject
    484 %d   date
    485 %m   message-id.
    486 
    487 You may use normal field width specification between the % and the letter.
    488 This is for example useful to limit the length of the subject.
    489 
    490 Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\""
    491   :group 'org-link-store
    492   :package-version '(Org . "9.3")
    493   :type 'string
    494   :safe #'stringp)
    495 
    496 (defcustom org-link-from-user-regexp
    497   (let ((mail (and (org-string-nw-p user-mail-address)
    498 		   (format "\\<%s\\>" (regexp-quote user-mail-address))))
    499 	(name (and (org-string-nw-p user-full-name)
    500 		   (format "\\<%s\\>" (regexp-quote user-full-name)))))
    501     (if (and mail name) (concat mail "\\|" name) (or mail name)))
    502   "Regexp matched against the \"From:\" header of an email or Usenet message.
    503 It should match if the message is from the user him/herself."
    504   :group 'org-link-store
    505   :type 'regexp
    506   :safe #'stringp)
    507 
    508 (defcustom org-link-keep-stored-after-insertion nil
    509   "Non-nil means keep link in list for entire session.
    510 \\<org-mode-map>
    511 The command `org-store-link' adds a link pointing to the current
    512 location to an internal list.  These links accumulate during a session.
    513 The command `org-insert-link' can be used to insert links into any
    514 Org file (offering completion for all stored links).
    515 
    516 When this option is nil, every link which has been inserted once using
    517 `\\[org-insert-link]' will be removed from the list, to make completing the \
    518 unused
    519 links more efficient."
    520   :group 'org-link-store
    521   :type 'boolean
    522   :safe #'booleanp)
    523 
    524 ;;; Public variables
    525 
    526 (defconst org-target-regexp (let ((border "[^<>\n\r \t]"))
    527 			      (format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>"
    528 				      border border border))
    529   "Regular expression matching a link target.")
    530 
    531 (defconst org-radio-target-regexp (format "<%s>" org-target-regexp)
    532   "Regular expression matching a radio target.")
    533 
    534 (defvar-local org-target-link-regexp nil
    535   "Regular expression matching radio targets in plain text.")
    536 (defconst org-target-link-regexp-limit (ash 2 12)
    537   "Maximum allowed length of regexp.
    538 The number should generally be ~order of magnitude smaller than
    539 MAX_BUF_SIZE in src/regex-emacs.c.  The number of regexp-emacs.c is
    540 for processed regexp, which appears to be larger compared to the
    541 original string length.")
    542 (defvar-local org-target-link-regexps nil
    543   "List of regular expressions matching radio targets in plain text.
    544 This list is non-nil, when a single regexp would be too long to match
    545 all the possible targets, exceeding Emacs's regexp length limit.")
    546 
    547 (defvar org-link-types-re nil
    548   "Matches a link that has a url-like prefix like \"http:\".")
    549 
    550 (defvar org-link-angle-re nil
    551   "Matches link with angular brackets, spaces are allowed.")
    552 
    553 (defvar org-link-plain-re nil
    554   "Matches plain link, without spaces.
    555 Group 1 must contain the link type (i.e. https).
    556 Group 2 must contain the link path (i.e. //example.com).
    557 Used by `org-element-link-parser'.")
    558 
    559 (defvar org-link-bracket-re nil
    560   "Matches a link in double brackets.")
    561 
    562 (defvar org-link-any-re nil
    563   "Regular expression matching any link.")
    564 
    565 (defvar-local org-link-abbrev-alist-local nil
    566   "Buffer-local version of `org-link-abbrev-alist', which see.
    567 The value of this is taken from the LINK keywords.")
    568 
    569 (defvar org-stored-links nil
    570   "Contains the links stored with `org-store-link'.")
    571 
    572 (defvar org-store-link-plist nil
    573   "Plist with info about the most recently link created with `org-store-link'.")
    574 
    575 (defvar org-create-file-search-functions nil
    576   "List of functions to construct the right search string for a file link.
    577 
    578 These functions are called in turn with point at the location to
    579 which the link should point.
    580 
    581 A function in the hook should first test if it would like to
    582 handle this file type, for example by checking the `major-mode'
    583 or the file extension.  If it decides not to handle this file, it
    584 should just return nil to give other functions a chance.  If it
    585 does handle the file, it must return the search string to be used
    586 when following the link.  The search string will be part of the
    587 file link, given after a double colon, and `org-open-at-point'
    588 will automatically search for it.  If special measures must be
    589 taken to make the search successful, another function should be
    590 added to the companion hook `org-execute-file-search-functions',
    591 which see.
    592 
    593 A function in this hook may also use `org-link-store-props' and set
    594 `:description' property to provide a suggestion for the descriptive
    595 text to be used for this link when it gets inserted into an Org buffer
    596 with \\[org-insert-link].")
    597 
    598 (defvar org-execute-file-search-functions nil
    599   "List of functions to execute a file search triggered by a link.
    600 
    601 Functions added to this hook must accept a single argument, the
    602 search string that was part of the file link, the part after the
    603 double colon.  The function must first check if it would like to
    604 handle this search, for example by checking the `major-mode' or
    605 the file extension.  If it decides not to handle this search, it
    606 should just return nil to give other functions a chance.  If it
    607 does handle the search, it must return a non-nil value to keep
    608 other functions from trying.
    609 
    610 Each function can access the current prefix argument through the
    611 variable `current-prefix-arg'.  Note that a single prefix is used
    612 to force opening a link in Emacs, so it may be good to only use a
    613 numeric or double prefix to guide the search function.
    614 
    615 In case this is needed, a function in this hook can also restore
    616 the window configuration before `org-open-at-point' was called using:
    617 
    618     (set-window-configuration org-window-config-before-follow-link)")
    619 
    620 (defvar org-open-link-functions nil
    621   "Hook for functions finding a plain text link.
    622 These functions must take a single argument, the link content.
    623 They will be called for links that look like [[link text][description]]
    624 when LINK TEXT does not have a protocol like \"http:\" and does not look
    625 like a filename (e.g. \"./blue.png\").
    626 
    627 These functions will be called *before* Org attempts to resolve the
    628 link by doing text searches in the current buffer - so if you want a
    629 link \"[[target]]\" to still find \"<<target>>\", your function should
    630 handle this as a special case.
    631 
    632 When the function does handle the link, it must return a non-nil value.
    633 If it decides that it is not responsible for this link, it must return
    634 nil to indicate that Org can continue with other options like
    635 exact and fuzzy text search.")
    636 
    637 
    638 ;;; Internal Variables
    639 
    640 (defconst org-link--forbidden-chars "]\t\n\r<>"
    641   "Characters forbidden within a link, as a string.")
    642 
    643 (defvar org-link--history nil
    644   "History for inserted links.")
    645 
    646 (defvar org-link--insert-history nil
    647   "Minibuffer history for links inserted with `org-insert-link'.")
    648 
    649 (defvar org-link--search-failed nil
    650   "Non-nil when last link search failed.")
    651 
    652 
    653 ;;; Internal Functions
    654 
    655 (defun org-link--try-special-completion (type)
    656   "If there is completion support for link type TYPE, offer it."
    657   (let ((fun (org-link-get-parameter type :complete)))
    658     (if (functionp fun)
    659 	(funcall fun)
    660       (read-string "Link (no completion support): " (concat type ":")))))
    661 
    662 (defun org-link--prettify (link)
    663   "Return a human-readable representation of LINK.
    664 The car of LINK must be a raw link.  The cdr of LINK must be
    665 either a link description or nil."
    666   (let ((desc (or (cadr link) "<no description>")))
    667     (concat (format "%-45s" (substring desc 0 (min (length desc) 40)))
    668 	    "<" (car link) ">")))
    669 
    670 (defun org-link--decode-compound (hex)
    671   "Unhexify Unicode hex-chars HEX.
    672 E.g. \"%C3%B6\" is the German o-Umlaut.  Note: this function also
    673 decodes single byte encodings like \"%E1\" (a-acute) if not
    674 followed by another \"%[A-F0-9]{2}\" group."
    675   (save-match-data
    676     (let* ((bytes (cdr (split-string hex "%")))
    677 	   (ret "")
    678 	   (eat 0)
    679 	   (sum 0))
    680       (while bytes
    681 	(let* ((val (string-to-number (pop bytes) 16))
    682 	       (shift-xor
    683 		(if (= 0 eat)
    684 		    (cond
    685 		     ((>= val 252) (cons 6 252))
    686 		     ((>= val 248) (cons 5 248))
    687 		     ((>= val 240) (cons 4 240))
    688 		     ((>= val 224) (cons 3 224))
    689 		     ((>= val 192) (cons 2 192))
    690 		     (t (cons 0 0)))
    691 		  (cons 6 128))))
    692 	  (when (>= val 192) (setq eat (car shift-xor)))
    693 	  (setq val (logxor val (cdr shift-xor)))
    694 	  (setq sum (+ (ash sum (car shift-xor)) val))
    695 	  (when (> eat 0) (setq eat (- eat 1)))
    696 	  (cond
    697 	   ((= 0 eat)			;multi byte
    698 	    (setq ret (concat ret (char-to-string sum)))
    699 	    (setq sum 0))
    700 	   ((not bytes)			; single byte(s)
    701 	    (setq ret (org-link--decode-single-byte-sequence hex))))))
    702       ret)))
    703 
    704 (defun org-link--decode-single-byte-sequence (hex)
    705   "Unhexify hex-encoded single byte character sequence HEX."
    706   (mapconcat (lambda (byte)
    707 	       (char-to-string (string-to-number byte 16)))
    708 	     (cdr (split-string hex "%"))
    709 	     ""))
    710 
    711 (defun org-link--fontify-links-to-this-file ()
    712   "Fontify links to the current file in `org-stored-links'."
    713   (let ((f (buffer-file-name)) a b)
    714     (setq a (mapcar (lambda(l)
    715 		      (let ((ll (car l)))
    716 			(when (and (string-match "^file:\\(.+\\)::" ll)
    717 				   (equal f (expand-file-name (match-string 1 ll))))
    718 			  ll)))
    719 		    org-stored-links))
    720     (when (featurep 'org-id)
    721       (setq b (mapcar (lambda(l)
    722 			(let ((ll (car l)))
    723 			  (when (and (string-match "^id:\\(.+\\)$" ll)
    724 				     (equal f (expand-file-name
    725 					       (or (org-id-find-id-file
    726 						    (match-string 1 ll)) ""))))
    727 			    ll)))
    728 		      org-stored-links)))
    729     (mapcar (lambda(l)
    730 	      (put-text-property 0 (length l) 'face 'font-lock-comment-face l))
    731 	    (delq nil (append a b)))))
    732 
    733 (defun org-link--buffer-for-internals ()
    734   "Return buffer used for displaying the target of internal links."
    735   (cond
    736    ((not org-link-use-indirect-buffer-for-internals) (current-buffer))
    737    ((string-suffix-p "(Clone)" (buffer-name))
    738     (message "Buffer is already a clone, not making another one")
    739     ;; We also do not modify visibility in this case.
    740     (current-buffer))
    741    (t		   ;make a new indirect buffer for displaying the link
    742     (let* ((indirect-buffer-name (concat (buffer-name) "(Clone)"))
    743 	   (indirect-buffer
    744 	    (or (get-buffer indirect-buffer-name)
    745 		(make-indirect-buffer (current-buffer)
    746 				      indirect-buffer-name
    747 				      'clone))))
    748       (with-current-buffer indirect-buffer (org-cycle-overview))
    749       indirect-buffer))))
    750 
    751 (defun org-link--search-radio-target (target)
    752   "Search a radio target matching TARGET in current buffer.
    753 White spaces are not significant."
    754   (let ((re (format "<<<%s>>>"
    755 		    (mapconcat #'regexp-quote
    756 			       (split-string target)
    757 			       "[ \t]+\\(?:\n[ \t]*\\)?")))
    758 	(origin (point)))
    759     (goto-char (point-min))
    760     (catch :radio-match
    761       (while (re-search-forward re nil t)
    762 	(forward-char -1)
    763 	(let ((object (org-element-context)))
    764 	  (when (org-element-type-p object 'radio-target)
    765 	    (goto-char (org-element-begin object))
    766 	    (org-fold-show-context 'link-search)
    767 	    (throw :radio-match nil))))
    768       (goto-char origin)
    769       (user-error "No match for radio target: %s" target))))
    770 
    771 (defun org-link--context-from-region ()
    772   "Return context string from active region, or nil."
    773   (when (org-region-active-p)
    774     (let ((context (buffer-substring (region-beginning) (region-end))))
    775       (when (and (wholenump org-link-context-for-files)
    776 		 (> org-link-context-for-files 0))
    777 	(let ((lines (org-split-string context "\n")))
    778 	  (setq context
    779 		(mapconcat #'identity
    780 			   (cl-subseq lines 0 org-link-context-for-files)
    781 			   "\n"))))
    782       context)))
    783 
    784 (defun org-link--normalize-string (string &optional context)
    785   "Remove ignored contents from STRING string and return it.
    786 This function removes contiguous white spaces and statistics
    787 cookies.  When optional argument CONTEXT is non-nil, it assumes
    788 STRING is a context string, and also removes special search
    789 syntax around the string."
    790   (let ((string
    791 	 (org-trim
    792 	  (replace-regexp-in-string
    793 	   (rx (one-or-more (any " \t")))
    794 	   " "
    795 	   (replace-regexp-in-string
    796 	    ;; Statistics cookie regexp.
    797 	    (rx (seq "[" (0+ digit) (or "%" (seq "/" (0+ digit))) "]"))
    798 	    " "
    799 	    string)))))
    800     (when context
    801       (while (cond ((and (string-prefix-p "(" string)
    802 			 (string-suffix-p ")" string))
    803 		    (setq string (org-trim (substring string 1 -1))))
    804 		   ((string-match "\\`[#*]+[ \t]*" string)
    805 		    (setq string (substring string (match-end 0))))
    806 		   (t nil))))
    807     string))
    808 
    809 (defun org-link--reveal-maybe (region _)
    810   "Reveal folded link in REGION when needed.
    811 This function is intended to be used as :fragile property of a folding
    812 spec."
    813   (org-with-point-at (car region)
    814     (not (org-in-regexp org-link-any-re))))
    815 
    816 (defun org-link--try-link-store-functions (interactive?)
    817   "Try storing external links, prompting if more than one is possible.
    818 
    819 Each function returned by `org-store-link-functions' is called in
    820 turn.  If multiple functions return non-nil, prompt for which
    821 link should be stored.
    822 
    823 Argument INTERACTIVE? indicates whether `org-store-link' was
    824 called interactively and is passed to the link store functions.
    825 
    826 Return t when a link has been stored in `org-link-store-props'."
    827   (let ((results-alist nil))
    828     (dolist (f (org-store-link-functions))
    829       (when (condition-case nil
    830                 (funcall f interactive?)
    831               ;; FIXME: The store function used (< Org 9.7) to accept
    832               ;; no arguments; provide backward compatibility support
    833               ;; for them.
    834               (wrong-number-of-arguments
    835                (funcall f)))
    836         ;; FIXME: return value is not link's plist, so we store the
    837         ;; new value before it is modified.  It would be cleaner to
    838         ;; ask store link functions to return the plist instead.
    839         (push (cons f (copy-sequence org-store-link-plist))
    840               results-alist)))
    841     (pcase results-alist
    842       (`nil nil)
    843       (`((,_ . ,_)) t)	;single choice: nothing to do
    844       (`((,name . ,_) . ,_)
    845        ;; Reinstate link plist associated to the chosen
    846        ;; function.
    847        (apply #'org-link-store-props
    848               (cdr (assoc-string
    849                     (completing-read
    850                      (format "Store link with (default %s): " name)
    851                      (mapcar #'car results-alist)
    852                      nil t nil nil (symbol-name name))
    853                     results-alist)))
    854        t))))
    855 
    856 (defun org-link--add-to-stored-links (link desc)
    857   "Add LINK to `org-stored-links' with description DESC."
    858   (cond
    859    ((not (member (list link desc) org-stored-links))
    860     (push (list link desc) org-stored-links)
    861     (message "Stored: %s" (or desc link)))
    862    ((equal (list link desc) (car org-stored-links))
    863     (message "This link has already been stored"))
    864    (t
    865     (setq org-stored-links
    866           (delete (list link desc) org-stored-links))
    867     (push (list link desc) org-stored-links)
    868     (message "Link moved to front: %s" (or desc link)))))
    869 
    870 (defun org-link--file-link-to-here ()
    871   "Return as (LINK . DESC) a file link with search string to here."
    872   (let ((link (concat "file:"
    873                       (abbreviate-file-name
    874                        (buffer-file-name (buffer-base-buffer)))))
    875         desc)
    876     (when org-link-context-for-files
    877       (pcase (org-link-precise-link-target)
    878         (`nil nil)
    879         (`(,search-string ,search-desc ,_position)
    880          (setq link (format "%s::%s" link search-string))
    881          (setq desc search-desc))))
    882     (cons link desc)))
    883 
    884 
    885 ;;; Public API
    886 
    887 (defun org-link-types ()
    888   "Return a list of known link types."
    889   (mapcar #'car org-link-parameters))
    890 
    891 (defun org-link-get-parameter (type key)
    892   "Get TYPE link property for KEY.
    893 TYPE is a string and KEY is a plist keyword.  See
    894 `org-link-parameters' for supported keywords."
    895   (plist-get (cdr (assoc type org-link-parameters))
    896 	     key))
    897 
    898 (defun org-link-set-parameters (type &rest parameters)
    899   "Set link TYPE properties to PARAMETERS.
    900 PARAMETERS should be keyword value pairs.  See
    901 `org-link-parameters' for supported keys."
    902   (when (member type '("coderef" "custom-id" "fuzzy" "radio"))
    903     (error "Cannot override reserved link type: %S" type))
    904   (let ((data (assoc type org-link-parameters)))
    905     (if data (setcdr data (org-combine-plists (cdr data) parameters))
    906       (push (cons type parameters) org-link-parameters)
    907       (org-link-make-regexps)
    908       (when (featurep 'org-element) (org-element-update-syntax)))))
    909 
    910 ;; This way, one can add multiple functions as, say, :follow parameter.
    911 ;; For example,
    912 ;; (add-function :before-until (org-link-get-parameter "id" :follow) #'my-function)
    913 ;; See https://orgmode.org/list/a123389c-8f86-4836-a4fe-1e3f4281d33b@app.fastmail.com
    914 (gv-define-setter org-link-get-parameter (value type key)
    915   `(org-link-set-parameters ,type ,key ,value))
    916 
    917 (defun org-link-make-regexps ()
    918   "Update the link regular expressions.
    919 This should be called after the variable `org-link-parameters' has changed."
    920   (let ((types-re (regexp-opt (org-link-types) t)))
    921     (setq org-link-types-re
    922 	  (concat "\\`" types-re ":")
    923 	  org-link-angle-re
    924 	  (format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>"
    925 		  types-re)
    926 	  org-link-plain-re
    927           (let* ((non-space-bracket "[^][ \t\n()<>]")
    928 	         (parenthesis
    929 		  `(seq (any "<([")
    930 		        (0+ (or (regex ,non-space-bracket)
    931 			        (seq (any "<([")
    932 				     (0+ (regex ,non-space-bracket))
    933 				     (any "])>"))))
    934 		        (any "])>"))))
    935 	    ;; Heuristics for an URL link inspired by
    936 	    ;; https://daringfireball.net/2010/07/improved_regex_for_matching_urls
    937 	    (rx-to-string
    938 	     `(seq word-start
    939                    ;; Link type: match group 1.
    940 		   (regexp ,types-re)
    941 		   ":"
    942                    ;; Link path: match group 2.
    943                    (group
    944 		    (1+ (or (regex ,non-space-bracket)
    945 			    ,parenthesis))
    946 		    (or (regexp "[^[:punct:] \t\n]")
    947 		        ?/
    948 		        ,parenthesis)))))
    949           org-link-bracket-re
    950           (rx (seq "[["
    951 	           ;; URI part: match group 1.
    952 	           (group
    953 	            (one-or-more
    954                      (or (not (any "[]\\"))
    955 			 (and "\\" (zero-or-more "\\\\") (any "[]"))
    956 			 (and (one-or-more "\\") (not (any "[]"))))))
    957 		   "]"
    958 		   ;; Description (optional): match group 2.
    959 		   (opt "[" (group (+? anything)) "]")
    960 		   "]"))
    961 	  org-link-any-re
    962 	  (concat "\\(" org-link-bracket-re "\\)\\|\\("
    963 		  org-link-angle-re "\\)\\|\\("
    964 		  org-link-plain-re "\\)"))))
    965 
    966 (defun org-link-complete-file (&optional arg)
    967   "Create a file link using completion.
    968 With optional ARG \\='(16), abbreviate the file name in the link."
    969   (let ((file (read-file-name "File: "))
    970 	(pwd (file-name-as-directory (expand-file-name ".")))
    971 	(pwd1 (file-name-as-directory (abbreviate-file-name
    972 				       (expand-file-name ".")))))
    973     (cond ((equal arg '(16))
    974 	   (concat "file:"
    975 		   (abbreviate-file-name (expand-file-name file))))
    976 	  ((string-match
    977 	    (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
    978 	   (concat "file:" (match-string 1 file)))
    979 	  ((string-match
    980 	    (concat "^" (regexp-quote pwd) "\\(.+\\)")
    981 	    (expand-file-name file))
    982 	   (concat "file:"
    983 		   (match-string 1 (expand-file-name file))))
    984 	  (t (concat "file:" file)))))
    985 
    986 (defun org-link-email-description (&optional fmt)
    987   "Return the description part of an email link.
    988 This takes information from `org-store-link-plist' and formats it
    989 according to FMT (default from `org-link-email-description-format')."
    990   (setq fmt (or fmt org-link-email-description-format))
    991   (let* ((p org-store-link-plist)
    992 	 (to (plist-get p :toaddress))
    993 	 (from (plist-get p :fromaddress))
    994 	 (table
    995 	  (list
    996 	   (cons "%c" (plist-get p :fromto))
    997 	   (cons "%F" (plist-get p :from))
    998 	   (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?"))
    999 	   (cons "%T" (plist-get p :to))
   1000 	   (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?"))
   1001 	   (cons "%s" (plist-get p :subject))
   1002 	   (cons "%d" (plist-get p :date))
   1003 	   (cons "%m" (plist-get p :message-id)))))
   1004     (when (string-match "%c" fmt)
   1005       ;; Check if the user wrote this message
   1006       (if (and org-link-from-user-regexp from to
   1007 	       (save-match-data (string-match org-link-from-user-regexp from)))
   1008 	  (setq fmt (replace-match "to %t" t t fmt))
   1009 	(setq fmt (replace-match "from %f" t t fmt))))
   1010     (org-replace-escapes fmt table)))
   1011 
   1012 (defun org-link-store-props (&rest plist)
   1013   "Store link properties PLIST.
   1014 The properties are pre-processed by extracting names, addresses
   1015 and dates."
   1016   (let ((x (plist-get plist :from)))
   1017     (when x
   1018       (let ((adr (mail-extract-address-components x)))
   1019 	(setq plist (plist-put plist :fromname (car adr)))
   1020 	(setq plist (plist-put plist :fromaddress (nth 1 adr))))))
   1021   (let ((x (plist-get plist :to)))
   1022     (when x
   1023       (let ((adr (mail-extract-address-components x)))
   1024 	(setq plist (plist-put plist :toname (car adr)))
   1025 	(setq plist (plist-put plist :toaddress (nth 1 adr))))))
   1026   (let ((x (ignore-errors (date-to-time (plist-get plist :date)))))
   1027     (when x
   1028       (setq plist (plist-put plist :date-timestamp
   1029 			     (format-time-string
   1030 			      (org-time-stamp-format t) x)))
   1031       (setq plist (plist-put plist :date-timestamp-inactive
   1032 			     (format-time-string
   1033 			      (org-time-stamp-format t t) x)))))
   1034   (let ((from (plist-get plist :from))
   1035 	(to (plist-get plist :to)))
   1036     (when (and from to org-link-from-user-regexp)
   1037       (setq plist
   1038 	    (plist-put plist :fromto
   1039 		       (if (string-match org-link-from-user-regexp from)
   1040 			   (concat "to %t")
   1041 			 (concat "from %f"))))))
   1042   (setq org-store-link-plist plist))
   1043 
   1044 (defun org-link-add-props (&rest plist)
   1045   "Add these properties to the link property list PLIST."
   1046   (let (key value)
   1047     (while plist
   1048       (setq key (pop plist) value (pop plist))
   1049       (setq org-store-link-plist
   1050 	    (plist-put org-store-link-plist key value)))))
   1051 
   1052 (defun org-link-encode (text table)
   1053   "Return percent escaped representation of string TEXT.
   1054 TEXT is a string with the text to escape.  TABLE is a list of
   1055 characters that should be escaped."
   1056   (mapconcat
   1057    (lambda (c)
   1058      (if (memq c table)
   1059 	 (mapconcat (lambda (e) (format "%%%.2X" e))
   1060 		    (or (encode-coding-char c 'utf-8)
   1061 			(error "Unable to percent escape character: %c" c))
   1062 		    "")
   1063        (char-to-string c)))
   1064    text ""))
   1065 
   1066 (defun org-link-decode (s)
   1067   "Decode percent-encoded parts in string S.
   1068 E.g. \"%C3%B6\" becomes the German o-Umlaut."
   1069   (replace-regexp-in-string "\\(%[0-9A-Za-z]\\{2\\}\\)+"
   1070 			    #'org-link--decode-compound s t t))
   1071 
   1072 (defun org-link-escape (link)
   1073   "Backslash-escape sensitive characters in string LINK."
   1074   (replace-regexp-in-string
   1075    (rx (seq (group (zero-or-more "\\")) (group (or string-end (any "[]")))))
   1076    (lambda (m)
   1077      (concat (match-string 1 m)
   1078 	     (match-string 1 m)
   1079 	     (and (/= (match-beginning 2) (match-end 2)) "\\")))
   1080    link nil t 1))
   1081 
   1082 (defun org-link-unescape (link)
   1083   "Remove escaping backslash characters from string LINK."
   1084   (replace-regexp-in-string
   1085    (rx (group (one-or-more "\\")) (or string-end (any "[]")))
   1086    (lambda (_)
   1087      (concat (make-string (/ (- (match-end 1) (match-beginning 1)) 2) ?\\)))
   1088    link nil t 1))
   1089 
   1090 (defun org-link-make-string (link &optional description)
   1091   "Make a bracket link, consisting of LINK and DESCRIPTION.
   1092 LINK is escaped with backslashes for inclusion in buffer."
   1093   (let* ((zero-width-space (string ?\x200B))
   1094 	 (description
   1095 	  (and (org-string-nw-p description)
   1096 	       ;; Description cannot contain two consecutive square
   1097 	       ;; brackets, or end with a square bracket.  To prevent
   1098 	       ;; this, insert a zero width space character between
   1099 	       ;; the brackets, or at the end of the description.
   1100 	       (replace-regexp-in-string
   1101 		"\\(]\\)\\(]\\)"
   1102 		(concat "\\1" zero-width-space "\\2")
   1103 		(replace-regexp-in-string "]\\'"
   1104 					  (concat "\\&" zero-width-space)
   1105 					  (org-trim description))))))
   1106     (if (not (org-string-nw-p link))
   1107         (or description
   1108             (error "Empty link"))
   1109       (format "[[%s]%s]"
   1110 	      (org-link-escape link)
   1111 	      (if description (format "[%s]" description) "")))))
   1112 
   1113 (defun org-store-link-functions ()
   1114   "List of functions that are called to create and store a link.
   1115 
   1116 The functions are defined in the `:store' property of
   1117 `org-link-parameters'.  Each function should accept an argument
   1118 INTERACTIVE? which indicates whether the user has initiated
   1119 `org-store-link' interactively.
   1120 
   1121 Each function will be called in turn with a single argument
   1122 INTERACTIVE? - non-nil when user interaction is allowed.  Each function
   1123 should check if it is responsible for creating this link (for example
   1124 by looking at the major mode).  If not, it must return nil.  If yes,
   1125 it should return a non-nil value after calling `org-link-store-props'
   1126 with a list of properties and values.  Special properties are:
   1127 
   1128 :type         The link prefix, like \"http\".  This must be given.
   1129 :link         The link, like \"http://www.astro.uva.nl/~dominik\".
   1130               This is obligatory as well.
   1131 :description  Optional default description for the second pair
   1132               of brackets in an Org mode link.  The user can still change
   1133               this when inserting this link into an Org mode buffer.
   1134 
   1135 In addition to these, any additional properties can be specified
   1136 and then used in capture templates."
   1137   (cl-loop for link in org-link-parameters
   1138 	   with store-func
   1139 	   do (setq store-func (org-link-get-parameter (car link) :store))
   1140 	   if store-func
   1141 	   collect store-func))
   1142 
   1143 (defun org-link-expand-abbrev (link)
   1144   "Replace link abbreviations in LINK string.
   1145 Abbreviations are defined in `org-link-abbrev-alist'."
   1146   (if (not (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link)) link
   1147     (let* ((key (match-string 1 link))
   1148 	   (as (or (assoc key org-link-abbrev-alist-local)
   1149 		   (assoc key org-link-abbrev-alist)))
   1150 	   (tag (and (match-end 2) (match-string 3 link)))
   1151 	   rpl)
   1152       (if (not as)
   1153 	  link
   1154 	(setq rpl (cdr as))
   1155         ;; Drop any potentially dangerous text properties like
   1156         ;; `modification-hooks' that may be used as an attack vector.
   1157         (substring-no-properties
   1158 	 (cond
   1159 	  ((symbolp rpl) (funcall rpl tag))
   1160 	  ((string-match "%(\\([^)]+\\))" rpl)
   1161            (let ((rpl-fun-symbol (intern-soft (match-string 1 rpl))))
   1162              ;; Using `unsafep-function' is not quite enough because
   1163              ;; Emacs considers functions like `genenv' safe, while
   1164              ;; they can potentially be used to expose private system
   1165              ;; data to attacker if abbreviated link is clicked.
   1166              (if (or (eq t (get rpl-fun-symbol 'org-link-abbrev-safe))
   1167                      (eq t (get rpl-fun-symbol 'pure)))
   1168                  (replace-match
   1169 	          (save-match-data
   1170 	            (funcall (intern-soft (match-string 1 rpl)) tag))
   1171 	          t t rpl)
   1172                (org-display-warning
   1173                 (format "Disabling unsafe link abbrev: %s
   1174 You may mark function safe via (put '%s 'org-link-abbrev-safe t)"
   1175                         rpl (match-string 1 rpl)))
   1176                (setq org-link-abbrev-alist-local (delete as org-link-abbrev-alist-local)
   1177                      org-link-abbrev-alist (delete as org-link-abbrev-alist))
   1178                link
   1179 	       )))
   1180 	  ((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
   1181 	  ((string-match "%h" rpl)
   1182 	   (replace-match (url-hexify-string (or tag "")) t t rpl))
   1183 	  (t (concat rpl tag))))))))
   1184 
   1185 (defun org-link-open (link &optional arg)
   1186   "Open a link object LINK.
   1187 
   1188 ARG is an optional prefix argument.  Some link types may handle
   1189 it.  For example, it determines what application to run when
   1190 opening a \"file\" link.
   1191 
   1192 Functions responsible for opening the link are either hard-coded
   1193 for internal and \"file\" links, or stored as a parameter in
   1194 `org-link-parameters', which see."
   1195   (let ((type (org-element-property :type link))
   1196 	(path (org-element-property :path link)))
   1197     (pcase type
   1198       ;; Opening a "file" link requires special treatment since we
   1199       ;; first need to integrate search option, if any.
   1200       ("file"
   1201        (let* ((option (org-element-property :search-option link))
   1202 	      (path (if option (concat path "::" option) path)))
   1203 	 (org-link-open-as-file path
   1204 				(pcase (org-element-property :application link)
   1205 				  ((guard arg) arg)
   1206 				  ("emacs" 'emacs)
   1207 				  ("sys" 'system)))))
   1208       ;; Internal links.
   1209       ((or "coderef" "custom-id" "fuzzy" "radio")
   1210        (unless (run-hook-with-args-until-success 'org-open-link-functions path)
   1211 	 (if (not arg) (org-mark-ring-push)
   1212 	   (switch-to-buffer-other-window (org-link--buffer-for-internals)))
   1213 	 (let ((destination
   1214 		(org-with-wide-buffer
   1215 		 (if (equal type "radio")
   1216 		     (org-link--search-radio-target path)
   1217 		   (org-link-search
   1218 		    (pcase type
   1219 		      ("custom-id" (concat "#" path))
   1220 		      ("coderef" (format "(%s)" path))
   1221 		      (_ path))
   1222 		    ;; Prevent fuzzy links from matching themselves.
   1223 		    (and (equal type "fuzzy")
   1224 			 (+ 2 (org-element-begin link)))))
   1225 		 (point))))
   1226 	   (unless (and (<= (point-min) destination)
   1227 			(>= (point-max) destination))
   1228 	     (widen))
   1229 	   (goto-char destination))))
   1230       (_
   1231        ;; Look for a dedicated "follow" function in custom links.
   1232        (let ((f (org-link-get-parameter type :follow)))
   1233 	 (when (functionp f)
   1234 	   ;; Function defined in `:follow' parameter may use a single
   1235 	   ;; argument, as it was mandatory before Org 9.4.  This is
   1236 	   ;; deprecated, but support it for now.
   1237 	   (condition-case nil
   1238 	       (funcall f path arg)
   1239 	     (wrong-number-of-arguments
   1240 	      (funcall f path)))))))))
   1241 
   1242 (defun org-link-open-from-string (s &optional arg)
   1243   "Open a link in the string S, as if it was in Org mode.
   1244 Optional argument ARG is passed to `org-open-file' when S is a
   1245 \"file\" link."
   1246   (interactive "sLink: \nP")
   1247   (pcase (with-temp-buffer
   1248 	   (let ((org-inhibit-startup nil))
   1249 	     (insert s)
   1250 	     (org-mode)
   1251 	     (goto-char (point-min))
   1252 	     (org-element-link-parser)))
   1253     (`nil (user-error "No valid link in %S" s))
   1254     (link (org-link-open link arg))))
   1255 
   1256 (defun org-link-search (s &optional avoid-pos stealth new-heading-container)
   1257   "Search for a search string S in the accessible part of the buffer.
   1258 
   1259 If S starts with \"#\", it triggers a custom ID search.
   1260 
   1261 If S is enclosed within parenthesis, it initiates a coderef
   1262 search.
   1263 
   1264 If S is surrounded by forward slashes, it is interpreted as
   1265 a regular expression.  In Org mode files, this will create an
   1266 `org-occur' sparse tree.  In ordinary files, `occur' will be used
   1267 to list matches.  If the current buffer is in `dired-mode', grep
   1268 will be used to search in all files.
   1269 
   1270 When AVOID-POS is given, ignore matches near that position.
   1271 
   1272 When optional argument STEALTH is non-nil, do not modify
   1273 visibility around point, thus ignoring `org-show-context-detail'
   1274 variable.
   1275 
   1276 When optional argument NEW-HEADING-CONTAINER is an element, any
   1277 new heading that is created (see
   1278 `org-link-search-must-match-exact-headline') will be added as a
   1279 subheading of NEW-HEADING-CONTAINER.  Otherwise, new headings are
   1280 created at level 1 at the end of the accessible part of the
   1281 buffer.
   1282 
   1283 Search is case-insensitive and ignores white spaces.  Return type
   1284 of matched result, which is either `dedicated' or `fuzzy'.  Search
   1285 respects buffer narrowing."
   1286   (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s))
   1287   (let* ((case-fold-search t)
   1288 	 (origin (point))
   1289 	 (normalized (replace-regexp-in-string "\n[ \t]*" " " s))
   1290 	 (starred (eq (string-to-char normalized) ?*))
   1291 	 (words (split-string (if starred (substring s 1) s)))
   1292 	 (s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)"))
   1293 	 (s-single-re (mapconcat #'regexp-quote words "[ \t]+"))
   1294 	 type)
   1295     (cond
   1296      ;; Check if there are any special search functions.
   1297      ((run-hook-with-args-until-success 'org-execute-file-search-functions s))
   1298      ((eq (string-to-char s) ?#)
   1299       ;; Look for a custom ID S if S starts with "#".
   1300       (let* ((id (substring normalized 1))
   1301 	     (match (org-find-property "CUSTOM_ID" id)))
   1302 	(if match (progn (goto-char match) (setf type 'dedicated))
   1303 	  (error "No match for custom ID: %s" id))))
   1304      ((string-match "\\`(\\(.*\\))\\'" normalized)
   1305       ;; Look for coderef targets if S is enclosed within parenthesis.
   1306       (let ((coderef (match-string-no-properties 1 normalized))
   1307 	    (re (substring s-single-re 1 -1)))
   1308 	(goto-char (point-min))
   1309 	(catch :coderef-match
   1310 	  (while (re-search-forward re nil t)
   1311 	    (let ((element (org-element-at-point)))
   1312 	      (when (and (org-element-type-p element '(example-block src-block))
   1313 			 (org-match-line
   1314 			  (concat ".*?" (org-src-coderef-regexp
   1315 					 (org-src-coderef-format element)
   1316 					 coderef))))
   1317 		(setq type 'dedicated)
   1318 		(goto-char (match-beginning 2))
   1319 		(throw :coderef-match nil))))
   1320 	  (goto-char origin)
   1321 	  (error "No match for coderef: %s" coderef))))
   1322      ((string-match "\\`/\\(.*\\)/\\'" normalized)
   1323       ;; Look for a regular expression.
   1324       (funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur)
   1325 	       (match-string 1 s)))
   1326      ;; From here, we handle fuzzy links.
   1327      ;;
   1328      ;; Look for targets, only if not in a headline search.
   1329      ((and (not starred)
   1330 	   (let ((target (format "<<%s>>" s-multi-re)))
   1331 	     (catch :target-match
   1332 	       (goto-char (point-min))
   1333 	       (while (re-search-forward target nil t)
   1334 		 (backward-char)
   1335 		 (let ((context (org-element-context)))
   1336 		   (when (org-element-type-p context 'target)
   1337 		     (setq type 'dedicated)
   1338 		     (goto-char (org-element-begin context))
   1339 		     (throw :target-match t))))
   1340 	       nil))))
   1341      ;; Look for elements named after S, only if not in a headline
   1342      ;; search.
   1343      ((and (not starred)
   1344 	   (let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re)))
   1345 	     (catch :name-match
   1346 	       (goto-char (point-min))
   1347 	       (while (re-search-forward name nil t)
   1348 		 (let* ((element (org-element-at-point))
   1349 			(name (org-element-property :name element)))
   1350 		   (when (and name (equal (mapcar #'upcase words) (mapcar #'upcase (split-string name))))
   1351 		     (setq type 'dedicated)
   1352 		     (forward-line 0)
   1353 		     (throw :name-match t))))
   1354 	       nil))))
   1355      ;; Regular text search.  Prefer headlines in Org mode buffers.
   1356      ;; Ignore COMMENT keyword, TODO keywords, priority cookies,
   1357      ;; statistics cookies and tags.
   1358      ((and (derived-mode-p 'org-mode)
   1359 	   (let ((title-re
   1360 		  (format "%s.*\\(?:%s[ \t]\\)?.*%s"
   1361 			  org-outline-regexp-bol
   1362 			  org-comment-string
   1363 			  (mapconcat #'regexp-quote words ".+"))))
   1364 	     (goto-char (point-min))
   1365 	     (catch :found
   1366 	       (while (re-search-forward title-re nil t)
   1367 		 (when (equal (mapcar #'upcase words)
   1368                               (mapcar #'upcase
   1369 			              (split-string
   1370 			               (org-link--normalize-string
   1371 				        (org-get-heading t t t t)))))
   1372 		   (throw :found t)))
   1373 	       nil)))
   1374       (forward-line 0)
   1375       (setq type 'dedicated))
   1376      ;; Offer to create non-existent headline depending on
   1377      ;; `org-link-search-must-match-exact-headline'.
   1378      ((and (derived-mode-p 'org-mode)
   1379 	   (eq org-link-search-must-match-exact-headline 'query-to-create)
   1380 	   (yes-or-no-p "No match - create this as a new heading? "))
   1381       (let* ((container-ok (and new-heading-container
   1382                                 (org-element-type-p new-heading-container '(headline))))
   1383              (new-heading-position (if container-ok
   1384                                        (- (org-element-end new-heading-container) 1)
   1385                                      (point-max)))
   1386              (new-heading-level (if container-ok
   1387                                     (+ 1 (org-element-property :level new-heading-container))
   1388                                   1)))
   1389         ;; Need to widen when target is outside accessible portion of
   1390         ;; buffer, since the we want the user to end up there.
   1391         (unless (and (<= (point-min) new-heading-position)
   1392                      (>= (point-max) new-heading-position))
   1393           (widen))
   1394         (goto-char new-heading-position)
   1395         (unless (bolp) (newline))
   1396         (org-insert-heading nil t new-heading-level)
   1397         (insert (if starred (substring s 1) s) "\n")
   1398         (forward-line -1)))
   1399      ;; Only headlines are looked after.  No need to process
   1400      ;; further: throw an error.
   1401      ((and (derived-mode-p 'org-mode)
   1402 	   (or starred org-link-search-must-match-exact-headline))
   1403       (goto-char origin)
   1404       (error "No match for fuzzy expression: %s" normalized))
   1405      ;; Regular text search.
   1406      ((catch :fuzzy-match
   1407 	(goto-char (point-min))
   1408 	(while (re-search-forward s-multi-re nil t)
   1409 	  ;; Skip match if it contains AVOID-POS or it is included in
   1410 	  ;; a link with a description but outside the description.
   1411 	  (unless (or (and avoid-pos
   1412 			   (<= (match-beginning 0) avoid-pos)
   1413 			   (> (match-end 0) avoid-pos))
   1414 		      (and (save-match-data
   1415 			     (org-in-regexp org-link-bracket-re))
   1416 			   (match-beginning 3)
   1417 			   (or (> (match-beginning 3) (point))
   1418 			       (<= (match-end 3) (point)))
   1419 			   (org-element-lineage
   1420 			    (save-match-data (org-element-context))
   1421 			    'link t)))
   1422 	    (goto-char (match-beginning 0))
   1423 	    (setq type 'fuzzy)
   1424 	    (throw :fuzzy-match t)))
   1425 	nil))
   1426      ;; All failed.  Throw an error.
   1427      (t (goto-char origin)
   1428 	(error "No match for fuzzy expression: %s" normalized)))
   1429     ;; Disclose surroundings of match, if appropriate.
   1430     (when (and (derived-mode-p 'org-mode) (not stealth))
   1431       (org-fold-show-context 'link-search))
   1432     type))
   1433 
   1434 (defun org-link-heading-search-string (&optional string)
   1435   "Make search string for the current headline or STRING.
   1436 
   1437 Search string starts with an asterisk.  COMMENT keyword and
   1438 statistics cookies are removed, and contiguous spaces are packed
   1439 into a single one.
   1440 
   1441 When optional argument STRING is non-nil, assume it a headline,
   1442 without any asterisk, TODO or COMMENT keyword, and without any
   1443 priority cookie or tag."
   1444   (concat "*"
   1445 	  (org-link--normalize-string
   1446 	   (or string (org-get-heading t t t t)))))
   1447 
   1448 (defun org-link-precise-link-target ()
   1449   "Determine search string and description for storing a link.
   1450 
   1451 If a search string (see `org-link-search') is found, return
   1452 list (SEARCH-STRING DESC POSITION).  Otherwise, return nil.
   1453 
   1454 If there is an active region, the contents (or a part of it, see
   1455 `org-link-context-for-files') is used as the search string.
   1456 
   1457 In Org buffers, if point is at a named element (such as a source
   1458 block), the name is used for the search string.  If at a heading,
   1459 its CUSTOM_ID is used to form a search string of the form
   1460 \"#id\", if present, otherwise the current heading text is used
   1461 in the form \"*Heading\".
   1462 
   1463 If none of those finds a suitable search string, the current line
   1464 is used as the search string.
   1465 
   1466 The description DESC is nil (meaning the user will be prompted
   1467 for a description when inserting the link) for search strings
   1468 based on a region or the current line.  For other cases, DESC is
   1469 a cleaned-up version of the name or heading at point.
   1470 
   1471 POSITION is the buffer position at which the search string
   1472 matches."
   1473   (let* ((region (org-link--context-from-region))
   1474          (result
   1475           (cond
   1476            (region
   1477             (list (org-link--normalize-string region t)
   1478                   nil
   1479                   (region-beginning)))
   1480 
   1481            ((derived-mode-p 'org-mode)
   1482             (let* ((element (org-element-at-point))
   1483                    (name (org-element-property :name element))
   1484                    (heading (org-element-lineage element '(headline inlinetask) t))
   1485                    (custom-id (org-entry-get heading "CUSTOM_ID")))
   1486               (cond
   1487                (name
   1488                 (list name
   1489                       name
   1490                       (org-element-begin element)))
   1491                ((org-before-first-heading-p)
   1492                 (list (org-link--normalize-string (org-current-line-string) t)
   1493                       nil
   1494                       (line-beginning-position)))
   1495                (heading
   1496                 (list (if custom-id (concat "#" custom-id)
   1497                         (org-link-heading-search-string))
   1498                       (org-link--normalize-string
   1499                        (org-get-heading t t t t))
   1500                       (org-element-begin heading))))))
   1501 
   1502            ;; Not in an org-mode buffer, no region
   1503            (t
   1504             (list (org-link--normalize-string (org-current-line-string) t)
   1505                   nil
   1506                   (line-beginning-position))))))
   1507 
   1508     ;; Only use search option if there is some text.
   1509     (when (org-string-nw-p (car result))
   1510       result)))
   1511 
   1512 (defun org-link-open-as-file (path in-emacs)
   1513   "Pretend PATH is a file name and open it.
   1514 
   1515 IN-EMACS is passed to `org-open-file'.
   1516 
   1517 According to \"file\"-link syntax, PATH may include additional
   1518 search options, separated from the file name with \"::\".
   1519 
   1520 This function is meant to be used as a possible tool for
   1521 `:follow' property in `org-link-parameters'."
   1522   (let* ((option (and (string-match "::\\(.*\\)\\'" path)
   1523 		      (match-string 1 path)))
   1524 	 (file-name (if (not option) path
   1525 		      (substring path 0 (match-beginning 0)))))
   1526     (if (and (string-match "[*?{]" (file-name-nondirectory file-name))
   1527              (not (file-exists-p file-name)))
   1528         (dired file-name)
   1529       (apply #'org-open-file
   1530 	     file-name
   1531 	     in-emacs
   1532 	     (cond ((not option) nil)
   1533 		   ((string-match-p "\\`[0-9]+\\'" option)
   1534 		    (list (string-to-number option)))
   1535 		   (t (list nil option)))))))
   1536 
   1537 (defun org-link-display-format (s)
   1538   "Replace links in string S with their description.
   1539 If there is no description, use the link target."
   1540   (save-match-data
   1541     (replace-regexp-in-string
   1542      org-link-bracket-re
   1543      (lambda (m) (or (match-string 2 m) (match-string 1 m)))
   1544      s nil t)))
   1545 
   1546 (defun org-link-add-angle-brackets (s)
   1547   "Wrap string S within angle brackets."
   1548   (unless (equal (substring s 0 1) "<") (setq s (concat "<" s)))
   1549   (unless (equal (substring s -1) ">") (setq s (concat s ">")))
   1550   s)
   1551 
   1552 
   1553 ;;; Built-in link types
   1554 
   1555 ;;;; "elisp" link type
   1556 (defun org-link--open-elisp (path _)
   1557   "Open a \"elisp\" type link.
   1558 PATH is the sexp to evaluate, as a string."
   1559   (if (or (and (org-string-nw-p org-link-elisp-skip-confirm-regexp)
   1560 	       (string-match-p org-link-elisp-skip-confirm-regexp path))
   1561 	  (not org-link-elisp-confirm-function)
   1562 	  (funcall org-link-elisp-confirm-function
   1563 		   (format "Execute %s as Elisp? "
   1564 			   (org-add-props path nil 'face 'org-warning))))
   1565       (message "%s => %s" path
   1566 	       (if (eq ?\( (string-to-char path))
   1567 		   (eval (read path))
   1568 		 (call-interactively (read path))))
   1569     (user-error "Abort")))
   1570 
   1571 (org-link-set-parameters "elisp" :follow #'org-link--open-elisp)
   1572 
   1573 ;;;; "file" link type
   1574 (org-link-set-parameters "file" :complete #'org-link-complete-file)
   1575 
   1576 ;;;; "help" link type
   1577 (defun org-link--open-help (path _)
   1578   "Open a \"help\" type link.
   1579 PATH is a symbol name, as a string."
   1580   (pcase (intern path)
   1581     ((and (pred fboundp) function) (describe-function function))
   1582     ((and (pred boundp) variable) (describe-variable variable))
   1583     (name (user-error "Unknown function or variable: %s" name))))
   1584 
   1585 (defun org-link--store-help (&optional _interactive?)
   1586   "Store \"help\" type link."
   1587   (when (eq major-mode 'help-mode)
   1588     (let ((symbol
   1589            (save-excursion
   1590 	     (goto-char (point-min))
   1591              ;; In case the help is about the key-binding, store the
   1592              ;; function instead.
   1593              (search-forward "runs the command " (line-end-position) t)
   1594              (read (current-buffer)))))
   1595       (org-link-store-props :type "help"
   1596                             :link (format "help:%s" symbol)
   1597                             :description nil))))
   1598 
   1599 (org-link-set-parameters "help"
   1600                          :follow #'org-link--open-help
   1601                          :store #'org-link--store-help)
   1602 
   1603 ;;;; "http", "https", "mailto", "ftp", and "news" link types
   1604 (dolist (scheme '("ftp" "http" "https" "mailto" "news"))
   1605   (org-link-set-parameters scheme
   1606 			   :follow
   1607 			   (lambda (url arg)
   1608 			     (browse-url (concat scheme ":" url) arg))))
   1609 
   1610 ;;;; "shell" link type
   1611 (defun org-link--open-shell (path _)
   1612   "Open a \"shell\" type link.
   1613 PATH is the command to execute, as a string."
   1614   (if (or (and (org-string-nw-p org-link-shell-skip-confirm-regexp)
   1615 	       (string-match-p org-link-shell-skip-confirm-regexp path))
   1616 	  (not org-link-shell-confirm-function)
   1617 	  (funcall org-link-shell-confirm-function
   1618 		   (format "Execute %s in shell? "
   1619 			   (org-add-props path nil 'face 'org-warning))))
   1620       (let ((buf (generate-new-buffer "*Org Shell Output*")))
   1621 	(message "Executing %s" path)
   1622 	(shell-command path buf)
   1623 	(when (featurep 'midnight)
   1624 	  (setq clean-buffer-list-kill-buffer-names
   1625 		(cons (buffer-name buf)
   1626 		      clean-buffer-list-kill-buffer-names))))
   1627     (user-error "Abort")))
   1628 
   1629 (org-link-set-parameters "shell" :follow #'org-link--open-shell)
   1630 
   1631 
   1632 ;;; Interactive Functions
   1633 
   1634 ;;;###autoload
   1635 (defun org-next-link (&optional search-backward)
   1636   "Move forward to the next link.
   1637 If the link is in hidden text, expose it.  When SEARCH-BACKWARD
   1638 is non-nil, move backward."
   1639   (interactive)
   1640   (let ((pos (point))
   1641 	(search-fun (if search-backward #'re-search-backward
   1642 		      #'re-search-forward)))
   1643     ;; Tweak initial position.  If last search failed, wrap around.
   1644     ;; Otherwise, make sure we do not match current link.
   1645     (cond
   1646      ((not (and org-link--search-failed (eq this-command last-command)))
   1647       (cond
   1648        ((and (not search-backward) (looking-at org-link-any-re))
   1649 	(goto-char (match-end 0)))
   1650        (search-backward
   1651 	(pcase (org-in-regexp org-link-any-re nil t)
   1652 	  (`(,beg . ,_) (goto-char beg))
   1653 	  (_ nil)))
   1654        (t nil)))
   1655      (search-backward
   1656       (goto-char (point-max))
   1657       (message "Link search wrapped back to end of buffer"))
   1658      (t
   1659       (goto-char (point-min))
   1660       (message "Link search wrapped back to beginning of buffer")))
   1661     (setq org-link--search-failed nil)
   1662     (catch :found
   1663       (while (funcall search-fun org-link-any-re nil t)
   1664 	(let ((context (save-excursion
   1665 			 (unless search-backward (forward-char -1))
   1666 			 (org-element-context))))
   1667 	  (pcase (org-element-lineage context 'link t)
   1668 	    (`nil nil)
   1669 	    (link
   1670 	     (goto-char (org-element-begin link))
   1671 	     (when (org-invisible-p) (org-fold-show-context 'link-search))
   1672 	     (throw :found t)))))
   1673       (goto-char pos)
   1674       (setq org-link--search-failed t)
   1675       (message "No further link found"))))
   1676 
   1677 ;;;###autoload
   1678 (defun org-previous-link ()
   1679   "Move backward to the previous link.
   1680 If the link is in hidden text, expose it."
   1681   (interactive)
   1682   (org-next-link t))
   1683 
   1684 ;;;###autoload
   1685 (defun org-toggle-link-display ()
   1686   "Toggle the literal or descriptive display of links in current buffer."
   1687   (interactive)
   1688   (setq org-link-descriptive (not org-link-descriptive))
   1689   (org-restart-font-lock))
   1690 
   1691 ;;;###autoload
   1692 (defun org-store-link (arg &optional interactive?)
   1693   "Store a link to the current location.
   1694 \\<org-mode-map>
   1695 This link is added to `org-stored-links' and can later be inserted
   1696 into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
   1697 When optional argument INTERACTIVE? is nil, the link is not stored in
   1698 `org-stored-links', but returned as a string.
   1699 
   1700 For some link types, a `\\[universal-argument]' prefix ARG is interpreted.  \
   1701 A single
   1702 `\\[universal-argument]' negates `org-link-context-for-files' for file links or
   1703 `org-gnus-prefer-web-links' for links to Usenet articles.
   1704 
   1705 A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \
   1706 skipping storing functions that are not
   1707 part of Org core.
   1708 
   1709 A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
   1710 prefix ARG forces storing a link for each line in the
   1711 active region.
   1712 
   1713 Assume the function is called interactively if INTERACTIVE? is
   1714 non-nil.
   1715 
   1716 In Org buffers, an additional \"human-readable\" simple file link
   1717 is stored as an alternative to persistent org-id or other links,
   1718 if at a heading with a CUSTOM_ID property or an element with a
   1719 NAME."
   1720   (interactive "P\np")
   1721   (org-load-modules-maybe)
   1722   (if (and (equal arg '(64)) (org-region-active-p))
   1723       (save-excursion
   1724 	(let ((end (region-end)))
   1725 	  (goto-char (region-beginning))
   1726 	  (set-mark (point))
   1727           (while (< (line-end-position) end)
   1728 	    (move-end-of-line 1) (activate-mark)
   1729 	    (let (current-prefix-arg)
   1730 	      (call-interactively 'org-store-link))
   1731 	    (move-beginning-of-line 2)
   1732 	    (set-mark (point)))))
   1733     (setq org-store-link-plist nil)
   1734     ;; Negate `org-context-in-file-links' when given a single universal arg.
   1735     (let ((org-link-context-for-files (org-xor org-link-context-for-files
   1736                                                (equal arg '(4))))
   1737           link desc search agenda-link) ;; description
   1738       (cond
   1739        ;; Store a link using an external link type, if any function is
   1740        ;; available, unless external link types are skipped for this
   1741        ;; call using two universal args.  If more than one function
   1742        ;; can generate a link from current location, ask the user
   1743        ;; which one to use.
   1744        ((and (not (equal arg '(16)))
   1745              (org-link--try-link-store-functions interactive?))
   1746         (setq link (plist-get org-store-link-plist :link))
   1747         ;; If store function actually set `:description' property, use
   1748         ;; it, even if it is nil.  Otherwise, fallback to nil (ask user).
   1749 	(setq desc (plist-get org-store-link-plist :description)))
   1750 
   1751        ;; Store a link from a remote editing buffer.
   1752        ((org-src-edit-buffer-p)
   1753 	(let ((coderef-format (org-src-coderef-format))
   1754 	      (format-link
   1755 	       (lambda (label)
   1756 		 (if org-src-source-file-name
   1757 		     (format "file:%s::(%s)" org-src-source-file-name label)
   1758 		   (format "(%s)" label)))))
   1759 	  (cond
   1760 	   ;; Code references do not exist in this type of buffer.
   1761 	   ;; Pretend we're linking from the source buffer directly.
   1762 	   ((not (memq (org-src-source-type) '(example-block src-block)))
   1763 	    (with-current-buffer (org-src-source-buffer)
   1764 	      (org-store-link arg interactive?))
   1765 	    (setq link nil))
   1766 	   ;; A code reference exists.  Use it.
   1767 	   ((save-excursion
   1768 	      (forward-line 0)
   1769 	      (re-search-forward (org-src-coderef-regexp coderef-format)
   1770 				 (line-end-position)
   1771 				 t))
   1772 	    (setq link (funcall format-link (match-string-no-properties 3))))
   1773 	   ;; No code reference.  Create a new one then store the link
   1774 	   ;; to it, but only in the function is called interactively.
   1775 	   (interactive?
   1776 	    (end-of-line)
   1777 	    (let* ((label (read-string "Code line label: "))
   1778 		   (reference (format coderef-format label))
   1779 		   (gc (- 79 (length reference))))
   1780 	      (if (< (current-column) gc)
   1781 		  (org-move-to-column gc t)
   1782 		(insert " "))
   1783 	      (insert reference)
   1784 	      (setq link (funcall format-link label))))
   1785 	   ;; No code reference, and non-interactive call.  Don't know
   1786 	   ;; what to do.  Give up.
   1787 	   (t (setq link nil)))))
   1788 
   1789        ;; We are in the agenda, link to referenced location
   1790        ((eq major-mode 'org-agenda-mode)
   1791 	(let ((m (or (get-text-property (point) 'org-hd-marker)
   1792 		     (get-text-property (point) 'org-marker))))
   1793 	  (when m
   1794 	    (org-with-point-at m
   1795 	      (setq agenda-link (org-store-link nil interactive?))))))
   1796 
   1797        ;; Calendar mode
   1798        ((eq major-mode 'calendar-mode)
   1799 	(let ((cd (calendar-cursor-to-date)))
   1800 	  (setq link
   1801 		(format-time-string
   1802                  (org-time-stamp-format)
   1803 		 (org-encode-time 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd))))
   1804 	  (org-link-store-props :type "calendar" :date cd)))
   1805 
   1806        ;; Image mode
   1807        ((eq major-mode 'image-mode)
   1808 	(setq link (concat "file:"
   1809 		           (abbreviate-file-name buffer-file-name)))
   1810 	(org-link-store-props :type "image" :file buffer-file-name))
   1811 
   1812        ;; In dired, store a link to the file of the current line
   1813        ((derived-mode-p 'dired-mode)
   1814 	(let ((file (dired-get-filename nil t)))
   1815 	  (setq file (if file
   1816 			 (abbreviate-file-name
   1817 			  (expand-file-name (dired-get-filename nil t)))
   1818 		       ;; Otherwise, no file so use current directory.
   1819 		       default-directory))
   1820 	  (setq link (concat "file:" file))))
   1821 
   1822        ;; Try `org-create-file-search-functions`.  If any are
   1823        ;; successful, create a file link to the current buffer with
   1824        ;; the provided search string.
   1825        ((setq search (run-hook-with-args-until-success
   1826 		      'org-create-file-search-functions))
   1827 	(setq link (concat "file:" (abbreviate-file-name buffer-file-name)
   1828 			   "::" search)
   1829               desc (plist-get org-store-link-plist :description)))
   1830 
   1831        ;; Main logic for storing built-in link types in org-mode
   1832        ;; buffers
   1833        ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
   1834 	(org-with-limited-levels
   1835 	 (cond
   1836 	  ;; Store a link using the target at point
   1837 	  ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
   1838 	   (setq link
   1839 		 (concat "file:"
   1840 			 (abbreviate-file-name
   1841 			  (buffer-file-name (buffer-base-buffer)))
   1842 			 "::" (match-string 1))
   1843                  ;; Target may be shortened when link is inserted.
   1844                  ;; Avoid [[target][file:~/org/test.org::target]]
   1845                  ;; links.  Maybe the case of identical target and
   1846                  ;; description should be handled by `org-insert-link'.
   1847                  desc nil))
   1848           (t
   1849 	   ;; Just link to current headline.
   1850            (let ((here (org-link--file-link-to-here)))
   1851              (setq link (car here))
   1852              (setq desc (cdr here)))))))
   1853 
   1854        ;; Buffer linked to file, but not an org-mode buffer.
   1855        ((buffer-file-name (buffer-base-buffer))
   1856 	;; Just link to this file here.
   1857         (let ((here (org-link--file-link-to-here)))
   1858           (setq link (car here))
   1859           (setq desc (cdr here))))
   1860 
   1861        (interactive?
   1862 	(user-error "No method for storing a link from this buffer"))
   1863 
   1864        (t (setq link nil)))
   1865 
   1866       ;; We're done setting link and desc, clean up
   1867       (when (consp link) (setq link (or (cdr link) (car link))))
   1868       (cond ((not desc))
   1869 	    ((equal desc "NONE") (setq desc nil))
   1870 	    (t (setq desc (org-link-display-format desc))))
   1871       ;; Store and return the link
   1872       (if (not (and interactive? link))
   1873 	  (or agenda-link (and link (org-link-make-string link desc)))
   1874         (org-link--add-to-stored-links link desc)
   1875         ;; In org buffers, store an additional "human-readable" link
   1876         ;; using custom id, if available.
   1877         (when (and (buffer-file-name (buffer-base-buffer))
   1878                    (derived-mode-p 'org-mode)
   1879                    (org-entry-get nil "CUSTOM_ID"))
   1880           (let ((here (org-link--file-link-to-here)))
   1881             (setq link (car here))
   1882             (setq desc (cdr here)))
   1883           (unless (equal (list link desc) (car org-stored-links))
   1884             (org-link--add-to-stored-links link desc)))
   1885         (car org-stored-links)))))
   1886 
   1887 ;;;###autoload
   1888 (defun org-insert-link (&optional complete-file link-location description)
   1889   "Insert a link.  At the prompt, enter the link.
   1890 
   1891 Completion can be used to insert any of the link protocol prefixes in use.
   1892 
   1893 The history can be used to select a link previously stored with
   1894 `org-store-link'.  When the empty string is entered (i.e. if you just
   1895 press `RET' at the prompt), the link defaults to the most recently
   1896 stored link.  As `SPC' triggers completion in the minibuffer, you need to
   1897 use `M-SPC' or `C-q SPC' to force the insertion of a space character.
   1898 Completion candidates include link descriptions.
   1899 
   1900 If there is a link under cursor then edit it.
   1901 
   1902 You will also be prompted for a description, and if one is given, it will
   1903 be displayed in the buffer instead of the link.
   1904 
   1905 If there is already a link at point, this command will allow you to edit
   1906 link and description parts.
   1907 
   1908 With a `\\[universal-argument]' prefix, prompts for a file to link to.  The \
   1909 file name can be
   1910 selected using completion.  The path to the file will be relative to the
   1911 current directory if the file is in the current directory or a subdirectory.
   1912 Otherwise, the link will be the absolute path as completed in the minibuffer
   1913 \(i.e. normally ~/path/to/file).  You can configure this behavior using the
   1914 option `org-link-file-path-type'.
   1915 
   1916 With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \
   1917 absolute path even if the file is in
   1918 the current directory or below.
   1919 
   1920 A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
   1921 prefix negates `org-link-keep-stored-after-insertion'.
   1922 
   1923 If the LINK-LOCATION parameter is non-nil, this value will be used as
   1924 the link location instead of reading one interactively.
   1925 
   1926 If the DESCRIPTION parameter is non-nil, this value will be used
   1927 as the default description.  If not, and the chosen link type has
   1928 a non-nil `:insert-description' parameter, that is used to
   1929 generate a description as described in `org-link-parameters'
   1930 docstring.  Otherwise, if `org-link-make-description-function' is
   1931 non-nil, this function will be called with the link target, and
   1932 the result will be the default link description.  When called
   1933 non-interactively, don't allow editing the default description."
   1934   (interactive "P")
   1935   (let* ((wcf (current-window-configuration))
   1936 	 (origbuf (current-buffer))
   1937 	 (region (when (org-region-active-p)
   1938 		   (buffer-substring (region-beginning) (region-end))))
   1939 	 (remove (and region (list (region-beginning) (region-end))))
   1940 	 (desc region)
   1941 	 (link link-location)
   1942 	 (abbrevs org-link-abbrev-alist-local)
   1943 	 (all-prefixes (append (mapcar #'car abbrevs)
   1944 			       (mapcar #'car org-link-abbrev-alist)
   1945 			       (org-link-types)))
   1946          entry link-original)
   1947     (cond
   1948      (link-location)		      ; specified by arg, just use it.
   1949      ((org-in-regexp org-link-bracket-re 1)
   1950       ;; We do have a link at point, and we are going to edit it.
   1951       (setq remove (list (match-beginning 0) (match-end 0)))
   1952       (setq desc (when (match-end 2) (match-string-no-properties 2)))
   1953       (setq link (read-string "Link: "
   1954 			      (org-link-unescape
   1955 			       (match-string-no-properties 1)))))
   1956      ((or (org-in-regexp org-link-angle-re)
   1957 	  (org-in-regexp org-link-plain-re))
   1958       ;; Convert to bracket link
   1959       (setq remove (list (match-beginning 0) (match-end 0))
   1960 	    link (read-string "Link: "
   1961 			      (org-unbracket-string "<" ">" (match-string 0)))))
   1962      ((member complete-file '((4) (16)))
   1963       ;; Completing read for file names.
   1964       (setq link (org-link-complete-file complete-file)))
   1965      (t
   1966       ;; Read link, with completion for stored links.
   1967       (org-link--fontify-links-to-this-file)
   1968       (switch-to-buffer-other-window "*Org Links*")
   1969       (with-current-buffer "*Org Links*"
   1970         (read-only-mode 1)
   1971         (let ((inhibit-read-only t)
   1972               ;; FIXME Duplicate: Also in 'ox.el'.
   1973               (propertize-help-key
   1974                (lambda (key)
   1975                  ;; Add `face' *and* `font-lock-face' to "work
   1976                  ;; reliably in any buffer", per a comment in
   1977                  ;; `help--key-description-fontified'.
   1978                  (propertize key
   1979                              'font-lock-face 'help-key-binding
   1980                              'face 'help-key-binding))))
   1981           (erase-buffer)
   1982           (insert
   1983            (apply #'format "Type %s to complete link type, then %s to complete destination.\n"
   1984                   (mapcar propertize-help-key
   1985                           (list "TAB" "RET"))))
   1986 	  (when org-stored-links
   1987             (insert (apply #'format "\nStored links accessible with %s/%s or %s/%s are:\n\n"
   1988                            (mapcar propertize-help-key
   1989                                    (list "<up>" "<down>"
   1990                                          "M-p" "M-n"
   1991                                          "RET"))))
   1992 	    (insert (mapconcat #'org-link--prettify
   1993 			       (reverse org-stored-links)
   1994 			       "\n"))))
   1995         (goto-char (point-min)))
   1996       (when (get-buffer-window "*Org Links*" 'visible)
   1997         (let ((cw (selected-window)))
   1998 	  (select-window (get-buffer-window "*Org Links*" 'visible))
   1999 	  (with-current-buffer "*Org Links*" (setq truncate-lines t))
   2000 	  (unless (pos-visible-in-window-p (point-max))
   2001 	    (org-fit-window-to-buffer))
   2002 	  (and (window-live-p cw) (select-window cw))))
   2003       (unwind-protect
   2004 	  ;; Fake a link history, containing the stored links.
   2005 	  (let ((org-link--history
   2006 		 (append (mapcar #'car org-stored-links)
   2007 			 org-link--insert-history)))
   2008 	    (setq link
   2009 		  (org-completing-read
   2010                    (org-format-prompt "Insert link" (caar org-stored-links))
   2011 		   (append
   2012 		    (mapcar (lambda (x) (concat x ":")) all-prefixes)
   2013 		    (mapcar #'car org-stored-links)
   2014                     ;; Allow description completion.  Avoid "nil" option
   2015                     ;; in the case of `completing-read-default' when
   2016                     ;; some links have no description.
   2017                     (delq nil (mapcar 'cadr org-stored-links)))
   2018 		   nil nil nil
   2019 		   'org-link--history
   2020 		   (caar org-stored-links)))
   2021 	    (unless (org-string-nw-p link) (user-error "No link selected"))
   2022 	    (dolist (l org-stored-links)
   2023 	      (when (equal link (cadr l))
   2024 		(setq link (car l))))
   2025 	    (when (or (member link all-prefixes)
   2026 		      (and (equal ":" (substring link -1))
   2027 			   (member (substring link 0 -1) all-prefixes)
   2028 			   (setq link (substring link 0 -1))))
   2029 	      (setq link (with-current-buffer origbuf
   2030 			   (org-link--try-special-completion link)))))
   2031         (when-let* ((window (get-buffer-window "*Org Links*" t)))
   2032           (quit-window 'kill window))
   2033 	(set-window-configuration wcf)
   2034 	(when (get-buffer "*Org Links*")
   2035           (kill-buffer "*Org Links*")))
   2036       (setq entry (assoc link org-stored-links))
   2037       (or entry (push link org-link--insert-history))
   2038       (setq desc (or desc (nth 1 entry)))))
   2039 
   2040     (setq link-original link)
   2041     (when (and (string-match org-link-plain-re link)
   2042 	       (not (string-match org-ts-regexp link)))
   2043       ;; URL-like link, normalize the use of angular brackets.
   2044       (setq link (org-unbracket-string "<" ">" link)))
   2045 
   2046     ;; Check if we are linking to the current file with a search
   2047     ;; option If yes, simplify the link by using only the search
   2048     ;; option.
   2049     (when (and (buffer-file-name (buffer-base-buffer))
   2050 	       (let ((case-fold-search nil))
   2051 		 (string-match "\\`file:\\(.+?\\)::" link)))
   2052       (let ((path (match-string-no-properties 1 link))
   2053 	    (search (substring-no-properties link (match-end 0))))
   2054 	(save-match-data
   2055 	  (when (equal (file-truename (buffer-file-name (buffer-base-buffer)))
   2056 		       (file-truename path))
   2057 	    ;; We are linking to this same file, with a search option
   2058 	    (setq link search)))))
   2059 
   2060     ;; Check if we can/should use a relative path.  If yes, simplify
   2061     ;; the link.
   2062     (let ((case-fold-search nil))
   2063       (when (string-match "\\`\\(file\\|docview\\):" link)
   2064 	(let* ((type (match-string-no-properties 0 link))
   2065 	       (path-start (match-end 0))
   2066 	       (search (and (string-match "::\\(.*\\)\\'" link)
   2067 			    (match-string 1 link)))
   2068 	       (path
   2069 		(if search
   2070 		    (substring-no-properties
   2071 		     link path-start (match-beginning 0))
   2072 		  (substring-no-properties link (match-end 0))))
   2073 	       (origpath path))
   2074 	  (cond
   2075 	   ((or (eq org-link-file-path-type 'absolute)
   2076 		(equal complete-file '(16)))
   2077 	    (setq path (abbreviate-file-name (expand-file-name path))))
   2078 	   ((eq org-link-file-path-type 'noabbrev)
   2079 	    (setq path (expand-file-name path)))
   2080 	   ((eq org-link-file-path-type 'relative)
   2081 	    (setq path (file-relative-name path)))
   2082 	   ((functionp org-link-file-path-type)
   2083 	    (setq path (funcall org-link-file-path-type path)))
   2084 	   (t
   2085 	    (save-match-data
   2086 	      (if (string-match (concat "^" (regexp-quote
   2087 					     (expand-file-name
   2088 					      (file-name-as-directory
   2089 					       default-directory))))
   2090 				(expand-file-name path))
   2091 		  ;; We are linking a file with relative path name.
   2092 		  (setq path (substring (expand-file-name path)
   2093 					(match-end 0)))
   2094 		(setq path (abbreviate-file-name (expand-file-name path)))))))
   2095 	  (setq link (concat type path (and search (concat "::" search))))
   2096 	  (when (equal desc origpath)
   2097 	    (setq desc path)))))
   2098 
   2099     (let* ((type
   2100             (cond
   2101              ((and all-prefixes
   2102                    (string-match (rx-to-string `(: string-start (submatch (or ,@all-prefixes)) ":")) link))
   2103               (match-string 1 link))
   2104              ((file-name-absolute-p link) "file")
   2105              ((string-match "\\`\\.\\.?/" link) "file")))
   2106            (initial-input
   2107             (cond
   2108              (description)
   2109              (desc)
   2110              ((org-link-get-parameter type :insert-description)
   2111               (let ((def (org-link-get-parameter type :insert-description)))
   2112                 (condition-case nil
   2113                     (cond
   2114                      ((stringp def) def)
   2115                      ((functionp def)
   2116                       (funcall def link desc)))
   2117                   (error
   2118                    (message "Can't get link description from org link parameter `:insert-description': %S"
   2119                             def)
   2120                    (sit-for 2)
   2121                    nil))))
   2122              (org-link-make-description-function
   2123               (condition-case nil
   2124                   (funcall org-link-make-description-function link desc)
   2125                 (error
   2126                  (message "Can't get link description from %S"
   2127                           org-link-make-description-function)
   2128                  (sit-for 2)
   2129                  nil))))))
   2130       (setq desc (if (called-interactively-p 'any)
   2131                      (read-string "Description: " initial-input)
   2132                    initial-input)))
   2133 
   2134     (when (funcall (if (equal complete-file '(64)) 'not 'identity)
   2135                    (not org-link-keep-stored-after-insertion))
   2136       (setq org-stored-links (delq (assoc link-original org-stored-links)
   2137                                    org-stored-links)))
   2138     (unless (org-string-nw-p desc) (setq desc nil))
   2139     (when remove (apply #'delete-region remove))
   2140     (insert (org-link-make-string link desc))
   2141     ;; Redisplay so as the new link has proper invisible characters.
   2142     (sit-for 0)))
   2143 
   2144 ;;;###autoload
   2145 (defun org-insert-all-links (arg &optional pre post)
   2146   "Insert all links in `org-stored-links'.
   2147 When a universal prefix, do not delete the links from `org-stored-links'.
   2148 When `ARG' is a number, insert the last N link(s).
   2149 `PRE' and `POST' are optional arguments to define a string to
   2150 prepend or to append."
   2151   (interactive "P")
   2152   (let ((org-link-keep-stored-after-insertion (equal arg '(4)))
   2153 	(links (copy-sequence org-stored-links))
   2154 	(pr (or pre "- "))
   2155 	(po (or post "\n"))
   2156 	(cnt 1) l)
   2157     (if (null org-stored-links)
   2158 	(message "No link to insert")
   2159       (while (and (or (listp arg) (>= arg cnt))
   2160 		  (setq l (if (listp arg)
   2161 			      (pop links)
   2162 			    (pop org-stored-links))))
   2163 	(setq cnt (1+ cnt))
   2164 	(insert pr)
   2165 	(org-insert-link nil (car l) (or (cadr l) "<no description>"))
   2166 	(insert po)))))
   2167 
   2168 ;;;###autoload
   2169 (defun org-insert-last-stored-link (arg)
   2170   "Insert the last link stored in `org-stored-links'."
   2171   (interactive "p")
   2172   (org-insert-all-links arg "" "\n"))
   2173 
   2174 ;;;###autoload
   2175 (defun org-insert-link-global ()
   2176   "Insert a link like Org mode does.
   2177 This command can be called in any mode to insert a link in Org syntax."
   2178   (interactive)
   2179   (org-load-modules-maybe)
   2180   (org-run-like-in-org-mode 'org-insert-link))
   2181 
   2182 (defun org--re-list-search-forward (regexp-list &optional bound noerror count)
   2183   "Like `re-search-forward', but REGEXP-LIST is a list of regexps.
   2184 BOUND, NOERROR, and COUNT are passed to `re-search-forward'."
   2185   (let (result (min-found most-positive-fixnum)
   2186                (pos-found nil)
   2187                (min-found-data nil)
   2188                (tail regexp-list))
   2189     (while tail
   2190       (setq result (save-excursion (re-search-forward (pop tail) bound t count)))
   2191       (when (and result (< result min-found))
   2192         (setq min-found result
   2193               pos-found (match-end 0)
   2194               min-found-data (match-data))))
   2195     (if (= most-positive-fixnum min-found)
   2196         (pcase noerror
   2197           (`t nil)
   2198           (_ (re-search-forward (car regexp-list) bound noerror count)))
   2199       (set-match-data min-found-data)
   2200       (goto-char pos-found))))
   2201 
   2202 (defun org--re-list-looking-at (regexp-list &optional inhibit-modify)
   2203   "Like `looking-at', but REGEXP-LIST is a list of regexps.
   2204 INHIBIT-MODIFY is passed to `looking-at'."
   2205   (catch :found
   2206     (while regexp-list
   2207       (when
   2208           (if inhibit-modify
   2209               (looking-at-p (pop regexp-list))
   2210             ;; FIXME: In Emacs <29, `looking-at' does not accept
   2211             ;; optional INHIBIT-MODIFY argument.
   2212             (looking-at (pop regexp-list)))
   2213         (throw :found t)))))
   2214 
   2215 ;;;###autoload
   2216 (defun org-update-radio-target-regexp ()
   2217   "Find all radio targets in this file and update the regular expression.
   2218 Also refresh fontification if needed."
   2219   (interactive)
   2220   (let ((old-regexp org-target-link-regexp)
   2221 	;; Some languages, e.g., Chinese, do not use spaces to
   2222         ;; separate words.  Also allow surrounding radio targets with
   2223 	;; line-breakable characters.
   2224 	(before-re "\\(?:^\\|[^[:alnum:]]\\|\\c|\\)\\(")
   2225 	(after-re "\\)\\(?:$\\|[^[:alnum:]]\\|\\c|\\)")
   2226 	(targets
   2227 	 (org-with-wide-buffer
   2228 	  (goto-char (point-min))
   2229 	  (let (rtn)
   2230 	    (while (re-search-forward org-radio-target-regexp nil t)
   2231 	      ;; Make sure point is really within the object.
   2232 	      (backward-char)
   2233 	      (let ((obj (org-element-context)))
   2234 		(when (org-element-type-p obj 'radio-target)
   2235 		  (cl-pushnew (org-element-property :value obj) rtn
   2236 			      :test #'equal))))
   2237 	    rtn))))
   2238     (setq targets
   2239           (sort targets
   2240                 (lambda (a b)
   2241                   (> (length a) (length b)))))
   2242     (setq org-target-link-regexp
   2243 	  (and targets
   2244 	       (concat before-re
   2245 		       (mapconcat
   2246 			(lambda (x)
   2247 			  (replace-regexp-in-string
   2248 			   " +" "\\s-+" (regexp-quote x) t t))
   2249 			targets
   2250 			"\\|")
   2251 		       after-re)))
   2252     (setq org-target-link-regexps nil)
   2253     (let (current-length sub-targets)
   2254       (when (<= org-target-link-regexp-limit (length org-target-link-regexp))
   2255         (while (or targets sub-targets)
   2256           (when (and sub-targets
   2257                      (or (not targets)
   2258                          (>= (+ current-length (length (car targets)))
   2259                             org-target-link-regexp-limit)))
   2260             (push (concat before-re
   2261                           (mapconcat
   2262 			   (lambda (x)
   2263 			     (replace-regexp-in-string
   2264 			      " +" "\\s-+" (regexp-quote x) t t))
   2265 			   (nreverse sub-targets)
   2266 			   "\\|")
   2267 		          after-re)
   2268                   org-target-link-regexps)
   2269             (setq current-length nil
   2270                   sub-targets nil))
   2271           (unless current-length
   2272             (setq current-length (+ (length before-re) (length after-re))))
   2273           (when targets (push (pop targets) sub-targets))
   2274           (cl-incf current-length (length (car sub-targets))))
   2275         (setq org-target-link-regexps (nreverse org-target-link-regexps))))
   2276     (unless (equal old-regexp org-target-link-regexp)
   2277       ;; Clean-up cache.
   2278       (let ((regexp (cond ((not old-regexp) org-target-link-regexp)
   2279 			  ((not org-target-link-regexp) old-regexp)
   2280 			  (t
   2281 			   (concat before-re
   2282 				   (mapconcat
   2283 				    (lambda (re)
   2284 				      (substring re (length before-re)
   2285 						 (- (length after-re))))
   2286 				    (list old-regexp org-target-link-regexp)
   2287 				    "\\|")
   2288 				   after-re)))))
   2289 	(when (and (featurep 'org-element)
   2290                    (not (bound-and-true-p org-mode-loading)))
   2291           (if org-target-link-regexps
   2292               (org-element-cache-reset)
   2293 	    (org-with-point-at 1
   2294 	      (while (re-search-forward regexp nil t)
   2295 	        (org-element-cache-refresh (match-beginning 1)))))))
   2296       ;; Re fontify buffer.
   2297       (when (memq 'radio org-highlight-links)
   2298 	(org-restart-font-lock)))))
   2299 
   2300 
   2301 ;;; Initialize Regexps
   2302 
   2303 (org-link-make-regexps)
   2304 
   2305 (provide 'ol)
   2306 
   2307 ;; Local variables:
   2308 ;; generated-autoload-file: "org-loaddefs.el"
   2309 ;; End:
   2310 
   2311 ;;; ol.el ends here