dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

ol.el (78714B)


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