123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109 |
- ;;; ol.el --- Org links library -*- lexical-binding: t; -*-
- ;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
- ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
- ;; Keywords: outlines, hypermedia, calendar, wp
- ;; This file is part of GNU Emacs.
- ;; GNU Emacs is free software; you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
- ;;; Commentary:
- ;; This library provides tooling to handle both external and internal
- ;; links.
- ;;; Code:
- (require 'org-macs)
- (org-assert-version)
- (require 'org-compat)
- (require 'org-macs)
- (require 'org-fold)
- (defvar clean-buffer-list-kill-buffer-names)
- (defvar org-agenda-buffer-name)
- (defvar org-comment-string)
- (defvar org-highlight-links)
- (defvar org-id-link-to-org-use-id)
- (defvar org-inhibit-startup)
- (defvar org-outline-regexp-bol)
- (defvar org-src-source-file-name)
- (defvar org-time-stamp-formats)
- (defvar org-ts-regexp)
- (declare-function calendar-cursor-to-date "calendar" (&optional error event))
- (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
- (declare-function org-at-heading-p "org" (&optional _))
- (declare-function org-back-to-heading "org" (&optional invisible-ok))
- (declare-function org-before-first-heading-p "org" ())
- (declare-function org-do-occur "org" (regexp &optional cleanup))
- (declare-function org-element-at-point "org-element" (&optional pom cached-only))
- (declare-function org-element-cache-refresh "org-element" (pos))
- (declare-function org-element-context "org-element" (&optional element))
- (declare-function org-element-lineage "org-element" (datum &optional types with-self))
- (declare-function org-element-link-parser "org-element" ())
- (declare-function org-element-property "org-element" (property element))
- (declare-function org-element-type "org-element" (element))
- (declare-function org-element-update-syntax "org-element" ())
- (declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
- (declare-function org-find-property "org" (property &optional value))
- (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
- (declare-function org-id-find-id-file "org-id" (id))
- (declare-function org-id-store-link "org-id" ())
- (declare-function org-insert-heading "org" (&optional arg invisible-ok top))
- (declare-function org-load-modules-maybe "org" (&optional force))
- (declare-function org-mark-ring-push "org" (&optional pos buffer))
- (declare-function org-mode "org" ())
- (declare-function org-occur "org" (regexp &optional keep-previous callback))
- (declare-function org-open-file "org" (path &optional in-emacs line search))
- (declare-function org-cycle-overview "org-cycle" ())
- (declare-function org-restart-font-lock "org" ())
- (declare-function org-run-like-in-org-mode "org" (cmd))
- (declare-function org-fold-show-context "org-fold" (&optional key))
- (declare-function org-src-coderef-format "org-src" (&optional element))
- (declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
- (declare-function org-src-edit-buffer-p "org-src" (&optional buffer))
- (declare-function org-src-source-buffer "org-src" ())
- (declare-function org-src-source-type "org-src" ())
- (declare-function org-time-stamp-format "org" (&optional long inactive))
- (declare-function outline-next-heading "outline" ())
- ;;; Customization
- (defgroup org-link nil
- "Options concerning links in Org mode."
- :tag "Org Link"
- :group 'org)
- (defcustom org-link-parameters nil
- "Alist of properties that defines all the links in Org mode.
- The key in each association is a string of the link type.
- Subsequent optional elements make up a property list for that
- type.
- All properties are optional. However, the most important ones
- are, in this order, `:follow', `:export', and `:store', described
- below.
- `:follow'
- Function used to follow the link, when the `org-open-at-point'
- command runs on it. It is called with two arguments: the path,
- as a string, and a universal prefix argument.
- Here, you may use `org-link-open-as-file' helper function for
- types similar to \"file\".
- `:export'
- Function that accepts four arguments:
- - the path, as a string,
- - the description as a string, or nil,
- - the export back-end,
- - the export communication channel, as a plist.
- When nil, export for that type of link is delegated to the
- back-end.
- `:store'
- Function responsible for storing the link. See the function
- `org-store-link-functions' for a description of the expected
- arguments.
- Additional properties provide more specific control over the
- link.
- `:activate-func'
- Function to run at the end of Font Lock activation. It must
- accept four arguments:
- - the buffer position at the start of the link,
- - the buffer position at its end,
- - the path, as a string,
- - a boolean, non-nil when the link has brackets.
- `:complete'
- Function that inserts a link with completion. The function
- takes one optional prefix argument.
- `:insert-description'
- String or function used as a default when prompting users for a
- link's description. A string is used as-is, a function is
- called with two arguments: the link location (a string such as
- \"~/foobar\", \"id:some-org-id\" or \"https://www.foo.com\")
- and the description generated by `org-insert-link'. It should
- return the description to use (this reflects the behaviour of
- `org-link-make-description-function'). If it returns nil, no
- default description is used, but no error is thrown (from the
- user's perspective, this is equivalent to a default description
- of \"\").
- `:display'
- Value for `invisible' text property on the hidden parts of the
- link. The most useful value is `full', which will not fold the
- link in descriptive display. Default is `org-link'.
- `:face'
- Face for the link, or a function returning a face. The
- function takes one argument, which is the path.
- The default face is `org-link'.
- `:help-echo'
- String or function used as a value for the `help-echo' text
- property. The function is called with one argument, the help
- string to display, and should return a string.
- `:htmlize-link'
- Function or plist for the `htmlize-link' text property. The
- function takes no argument.
- Default is (:uri \"type:path\")
- `:keymap'
- Active keymap when point is on the link. Default is
- `org-mouse-map'.
- `:mouse-face'
- Face used when hovering over the link. Default is
- `highlight'."
- :group 'org-link
- :package-version '(Org . "9.1")
- :type '(alist :tag "Link display parameters"
- :value-type plist))
- (defcustom org-link-descriptive t
- "Non-nil means Org displays descriptive links.
- E.g. [[https://orgmode.org][Org website]] is displayed as
- \"Org Website\", hiding the link itself and just displaying its
- description. When set to nil, Org displays the full links
- literally.
- You can interactively set the value of this variable by calling
- `org-toggle-link-display' or from the \"Org > Hyperlinks\" menu."
- :group 'org-link
- :type 'boolean
- :safe #'booleanp)
- (defcustom org-link-make-description-function nil
- "Function to use for generating link descriptions from links.
- This function must take two parameters: the first one is the
- link, the second one is the description generated by
- `org-insert-link'. The function should return the description to
- use. If it returns nil, no default description is used, but no
- error is thrown (from the user’s perspective, this is equivalent
- to a default description of \"\")."
- :group 'org-link
- :type '(choice (const nil) (function))
- :safe #'null)
- (defcustom org-link-file-path-type 'adaptive
- "How the path name in file links should be stored.
- Valid values are:
- relative Relative to the current directory, i.e. the directory of the file
- into which the link is being inserted.
- absolute Absolute path, if possible with ~ for home directory.
- noabbrev Absolute path, no abbreviation of home directory.
- adaptive Use relative path for files in the current directory and sub-
- directories of it. For other files, use an absolute path.
- Alternatively, users may supply a custom function that takes the
- full filename as an argument and returns the path."
- :group 'org-link
- :type '(choice
- (const relative)
- (const absolute)
- (const noabbrev)
- (const adaptive)
- (function))
- :package-version '(Org . "9.5")
- :safe #'symbolp)
- (defcustom org-link-abbrev-alist nil
- "Alist of link abbreviations.
- The car of each element is a string, to be replaced at the start of a link.
- The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated
- links in Org buffers can have an optional tag after a double colon, e.g.,
- [[linkkey:tag][description]]
- The `linkkey' must be a single word, starting with a letter, followed
- by letters, numbers, `-' or `_'.
- If REPLACE is a string, the tag will simply be appended to create the link.
- If the string contains \"%s\", the tag will be inserted there. If the string
- contains \"%h\", it will cause a url-encoded version of the tag to be inserted
- at that point (see the function `url-hexify-string'). If the string contains
- the specifier \"%(my-function)\", then the custom function `my-function' will
- be invoked: this function takes the tag as its only argument and must return
- a string.
- REPLACE may also be a function that will be called with the tag as the
- only argument to create the link, which should be returned as a string.
- See the manual for examples."
- :group 'org-link
- :type '(repeat
- (cons (string :tag "Protocol")
- (choice
- (string :tag "Format")
- (function))))
- :safe (lambda (val)
- (pcase val
- (`(,(pred stringp) . ,(pred stringp)) t)
- (_ nil))))
- (defgroup org-link-follow nil
- "Options concerning following links in Org mode."
- :tag "Org Follow Link"
- :group 'org-link)
- (defcustom org-link-translation-function nil
- "Function to translate links with different syntax to Org syntax.
- This can be used to translate links created for example by the Planner
- or emacs-wiki packages to Org syntax.
- The function must accept two parameters, a TYPE containing the link
- protocol name like \"rmail\" or \"gnus\" as a string, and the linked path,
- which is everything after the link protocol. It should return a cons
- with possibly modified values of type and path.
- Org contains a function for this, so if you set this variable to
- `org-translate-link-from-planner', you should be able follow many
- links created by planner."
- :group 'org-link-follow
- :type '(choice (const nil) (function))
- :safe #'null)
- (defcustom org-link-frame-setup
- '((vm . vm-visit-folder-other-frame)
- (vm-imap . vm-visit-imap-folder-other-frame)
- (gnus . org-gnus-no-new-news)
- (file . find-file-other-window)
- (wl . wl-other-frame))
- "Setup the frame configuration for following links.
- When following a link with Emacs, it may often be useful to display
- this link in another window or frame. This variable can be used to
- set this up for the different types of links.
- For VM, use any of
- `vm-visit-folder'
- `vm-visit-folder-other-window'
- `vm-visit-folder-other-frame'
- For Gnus, use any of
- `gnus'
- `gnus-other-frame'
- `org-gnus-no-new-news'
- For FILE, use any of
- `find-file'
- `find-file-other-window'
- `find-file-other-frame'
- For Wanderlust use any of
- `wl'
- `wl-other-frame'
- For the calendar, use the variable `calendar-setup'.
- For BBDB, it is currently only possible to display the matches in
- another window."
- :group 'org-link-follow
- :type '(list
- (cons (const vm)
- (choice
- (const vm-visit-folder)
- (const vm-visit-folder-other-window)
- (const vm-visit-folder-other-frame)))
- (cons (const vm-imap)
- (choice
- (const vm-visit-imap-folder)
- (const vm-visit-imap-folder-other-window)
- (const vm-visit-imap-folder-other-frame)))
- (cons (const gnus)
- (choice
- (const gnus)
- (const gnus-other-frame)
- (const org-gnus-no-new-news)))
- (cons (const file)
- (choice
- (const find-file)
- (const find-file-other-window)
- (const find-file-other-frame)))
- (cons (const wl)
- (choice
- (const wl)
- (const wl-other-frame)))))
- (defcustom org-link-search-must-match-exact-headline 'query-to-create
- "Non-nil means internal fuzzy links can only match headlines.
- When nil, the a fuzzy link may point to a target or a named
- construct in the document. When set to the special value
- `query-to-create', offer to create a new headline when none
- matched.
- Spaces and statistics cookies are ignored during heading searches."
- :group 'org-link-follow
- :version "24.1"
- :type '(choice
- (const :tag "Use fuzzy text search" nil)
- (const :tag "Match only exact headline" t)
- (const :tag "Match exact headline or query to create it"
- query-to-create))
- :safe #'symbolp)
- (defcustom org-link-use-indirect-buffer-for-internals nil
- "Non-nil means use indirect buffer to display infile links.
- Activating internal links (from one location in a file to another location
- in the same file) normally just jumps to the location. When the link is
- activated with a `\\[universal-argument]' prefix (or with mouse-3), the link \
- is displayed in
- another window. When this option is set, the other window actually displays
- an indirect buffer clone of the current buffer, to avoid any visibility
- changes to the current buffer."
- :group 'org-link-follow
- :type 'boolean
- :safe #'booleanp)
- (defcustom org-link-shell-confirm-function 'yes-or-no-p
- "Non-nil means ask for confirmation before executing shell links.
- Shell links can be dangerous: just think about a link
- [[shell:rm -rf ~/*][Web Search]]
- This link would show up in your Org document as \"Web Search\",
- but really it would remove your entire home directory.
- Therefore we advise against setting this variable to nil.
- Just change it to `y-or-n-p' if you want to confirm with a
- single keystroke rather than having to type \"yes\"."
- :group 'org-link-follow
- :type '(choice
- (const :tag "with yes-or-no (safer)" yes-or-no-p)
- (const :tag "with y-or-n (faster)" y-or-n-p)
- (const :tag "no confirmation (dangerous)" nil)))
- (defcustom org-link-shell-skip-confirm-regexp ""
- "Regexp to skip confirmation for shell links."
- :group 'org-link-follow
- :version "24.1"
- :type 'regexp)
- (defcustom org-link-elisp-confirm-function 'yes-or-no-p
- "Non-nil means ask for confirmation before executing Emacs Lisp links.
- Elisp links can be dangerous: just think about a link
- [[elisp:(shell-command \"rm -rf ~/*\")][Web Search]]
- This link would show up in your Org document as \"Web Search\",
- but really it would remove your entire home directory.
- Therefore we advise against setting this variable to nil.
- Just change it to `y-or-n-p' if you want to confirm with a
- single keystroke rather than having to type \"yes\"."
- :group 'org-link-follow
- :type '(choice
- (const :tag "with yes-or-no (safer)" yes-or-no-p)
- (const :tag "with y-or-n (faster)" y-or-n-p)
- (const :tag "no confirmation (dangerous)" nil)))
- (defcustom org-link-elisp-skip-confirm-regexp ""
- "A regexp to skip confirmation for Elisp links."
- :group 'org-link-follow
- :version "24.1"
- :type 'regexp)
- (defgroup org-link-store nil
- "Options concerning storing links in Org mode."
- :tag "Org Store Link"
- :group 'org-link)
- (defcustom org-link-context-for-files t
- "Non-nil means file links from `org-store-link' contain context.
- \\<org-mode-map>
- A search string is added to the file name with \"::\" as separator
- and used to find the context when the link is activated by the command
- `org-open-at-point'. When this option is t, the entire active region
- is be placed in the search string of the file link. If set to a
- positive integer N, only the first N lines of context are stored.
- Using a prefix argument to the command `org-store-link' \
- \(`\\[universal-argument] \\[org-store-link]')
- negates this setting for the duration of the command."
- :group 'org-link-store
- :type '(choice boolean integer)
- :safe (lambda (val) (or (booleanp val) (integerp val))))
- (defcustom org-link-email-description-format "Email %c: %s"
- "Format of the description part of a link to an email or Usenet message.
- The following %-escapes will be replaced by corresponding information:
- %F full \"From\" field
- %f name, taken from \"From\" field, address if no name
- %T full \"To\" field
- %t first name in \"To\" field, address if no name
- %c correspondent. Usually \"from NAME\", but if you sent it yourself, it
- will be \"to NAME\". See also the variable `org-from-is-user-regexp'.
- %s subject
- %d date
- %m message-id.
- You may use normal field width specification between the % and the letter.
- This is for example useful to limit the length of the subject.
- Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\""
- :group 'org-link-store
- :package-version '(Org . "9.3")
- :type 'string
- :safe #'stringp)
- (defcustom org-link-from-user-regexp
- (let ((mail (and (org-string-nw-p user-mail-address)
- (format "\\<%s\\>" (regexp-quote user-mail-address))))
- (name (and (org-string-nw-p user-full-name)
- (format "\\<%s\\>" (regexp-quote user-full-name)))))
- (if (and mail name) (concat mail "\\|" name) (or mail name)))
- "Regexp matched against the \"From:\" header of an email or Usenet message.
- It should match if the message is from the user him/herself."
- :group 'org-link-store
- :type 'regexp
- :safe #'stringp)
- (defcustom org-link-keep-stored-after-insertion nil
- "Non-nil means keep link in list for entire session.
- \\<org-mode-map>
- The command `org-store-link' adds a link pointing to the current
- location to an internal list. These links accumulate during a session.
- The command `org-insert-link' can be used to insert links into any
- Org file (offering completion for all stored links).
- When this option is nil, every link which has been inserted once using
- `\\[org-insert-link]' will be removed from the list, to make completing the \
- unused
- links more efficient."
- :group 'org-link-store
- :type 'boolean
- :safe #'booleanp)
- ;;; Public variables
- (defconst org-target-regexp (let ((border "[^<>\n\r \t]"))
- (format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>"
- border border border))
- "Regular expression matching a link target.")
- (defconst org-radio-target-regexp (format "<%s>" org-target-regexp)
- "Regular expression matching a radio target.")
- (defvar-local org-target-link-regexp nil
- "Regular expression matching radio targets in plain text.")
- (defvar org-link-types-re nil
- "Matches a link that has a url-like prefix like \"http:\".")
- (defvar org-link-angle-re nil
- "Matches link with angular brackets, spaces are allowed.")
- (defvar org-link-plain-re nil
- "Matches plain link, without spaces.
- Group 1 must contain the link type (i.e. https).
- Group 2 must contain the link path (i.e. //example.com).
- Used by `org-element-link-parser'.")
- (defvar org-link-bracket-re nil
- "Matches a link in double brackets.")
- (defvar org-link-any-re nil
- "Regular expression matching any link.")
- (defvar-local org-link-abbrev-alist-local nil
- "Buffer-local version of `org-link-abbrev-alist', which see.
- The value of this is taken from the LINK keywords.")
- (defvar org-stored-links nil
- "Contains the links stored with `org-store-link'.")
- (defvar org-store-link-plist nil
- "Plist with info about the most recently link created with `org-store-link'.")
- (defvar org-create-file-search-functions nil
- "List of functions to construct the right search string for a file link.
- These functions are called in turn with point at the location to
- which the link should point.
- A function in the hook should first test if it would like to
- handle this file type, for example by checking the `major-mode'
- or the file extension. If it decides not to handle this file, it
- should just return nil to give other functions a chance. If it
- does handle the file, it must return the search string to be used
- when following the link. The search string will be part of the
- file link, given after a double colon, and `org-open-at-point'
- will automatically search for it. If special measures must be
- taken to make the search successful, another function should be
- added to the companion hook `org-execute-file-search-functions',
- which see.
- A function in this hook may also use `setq' to set the variable
- `description' to provide a suggestion for the descriptive text to
- be used for this link when it gets inserted into an Org buffer
- with \\[org-insert-link].")
- (defvar org-execute-file-search-functions nil
- "List of functions to execute a file search triggered by a link.
- Functions added to this hook must accept a single argument, the
- search string that was part of the file link, the part after the
- double colon. The function must first check if it would like to
- handle this search, for example by checking the `major-mode' or
- the file extension. If it decides not to handle this search, it
- should just return nil to give other functions a chance. If it
- does handle the search, it must return a non-nil value to keep
- other functions from trying.
- Each function can access the current prefix argument through the
- variable `current-prefix-arg'. Note that a single prefix is used
- to force opening a link in Emacs, so it may be good to only use a
- numeric or double prefix to guide the search function.
- In case this is needed, a function in this hook can also restore
- the window configuration before `org-open-at-point' was called using:
- (set-window-configuration org-window-config-before-follow-link)")
- (defvar org-open-link-functions nil
- "Hook for functions finding a plain text link.
- These functions must take a single argument, the link content.
- They will be called for links that look like [[link text][description]]
- when LINK TEXT does not have a protocol like \"http:\" and does not look
- like a filename (e.g. \"./blue.png\").
- These functions will be called *before* Org attempts to resolve the
- link by doing text searches in the current buffer - so if you want a
- link \"[[target]]\" to still find \"<<target>>\", your function should
- handle this as a special case.
- When the function does handle the link, it must return a non-nil value.
- If it decides that it is not responsible for this link, it must return
- nil to indicate that Org can continue with other options like
- exact and fuzzy text search.")
- ;;; Internal Variables
- (defconst org-link--forbidden-chars "]\t\n\r<>"
- "Characters forbidden within a link, as a string.")
- (defvar org-link--history nil
- "History for inserted links.")
- (defvar org-link--insert-history nil
- "Minibuffer history for links inserted with `org-insert-link'.")
- (defvar org-link--search-failed nil
- "Non-nil when last link search failed.")
- (defvar-local org-link--link-folding-spec '(org-link
- (:global t)
- (:ellipsis . nil)
- (:isearch-open . t)
- (:fragile . org-link--reveal-maybe))
- "Folding spec used to hide invisible parts of links.")
- (defvar-local org-link--description-folding-spec '(org-link-description
- (:global t)
- (:ellipsis . nil)
- (:visible . t)
- (:isearch-open . nil)
- (:fragile . org-link--reveal-maybe))
- "Folding spec used to reveal link description.")
- ;;; Internal Functions
- (defun org-link--try-special-completion (type)
- "If there is completion support for link type TYPE, offer it."
- (let ((fun (org-link-get-parameter type :complete)))
- (if (functionp fun)
- (funcall fun)
- (read-string "Link (no completion support): " (concat type ":")))))
- (defun org-link--prettify (link)
- "Return a human-readable representation of LINK.
- The car of LINK must be a raw link. The cdr of LINK must be
- either a link description or nil."
- (let ((desc (or (cadr link) "<no description>")))
- (concat (format "%-45s" (substring desc 0 (min (length desc) 40)))
- "<" (car link) ">")))
- (defun org-link--decode-compound (hex)
- "Unhexify Unicode hex-chars HEX.
- E.g. \"%C3%B6\" is the German o-Umlaut. Note: this function also
- decodes single byte encodings like \"%E1\" (a-acute) if not
- followed by another \"%[A-F0-9]{2}\" group."
- (save-match-data
- (let* ((bytes (cdr (split-string hex "%")))
- (ret "")
- (eat 0)
- (sum 0))
- (while bytes
- (let* ((val (string-to-number (pop bytes) 16))
- (shift-xor
- (if (= 0 eat)
- (cond
- ((>= val 252) (cons 6 252))
- ((>= val 248) (cons 5 248))
- ((>= val 240) (cons 4 240))
- ((>= val 224) (cons 3 224))
- ((>= val 192) (cons 2 192))
- (t (cons 0 0)))
- (cons 6 128))))
- (when (>= val 192) (setq eat (car shift-xor)))
- (setq val (logxor val (cdr shift-xor)))
- (setq sum (+ (ash sum (car shift-xor)) val))
- (when (> eat 0) (setq eat (- eat 1)))
- (cond
- ((= 0 eat) ;multi byte
- (setq ret (concat ret (char-to-string sum)))
- (setq sum 0))
- ((not bytes) ; single byte(s)
- (setq ret (org-link--decode-single-byte-sequence hex))))))
- ret)))
- (defun org-link--decode-single-byte-sequence (hex)
- "Unhexify hex-encoded single byte character sequence HEX."
- (mapconcat (lambda (byte)
- (char-to-string (string-to-number byte 16)))
- (cdr (split-string hex "%"))
- ""))
- (defun org-link--fontify-links-to-this-file ()
- "Fontify links to the current file in `org-stored-links'."
- (let ((f (buffer-file-name)) a b)
- (setq a (mapcar (lambda(l)
- (let ((ll (car l)))
- (when (and (string-match "^file:\\(.+\\)::" ll)
- (equal f (expand-file-name (match-string 1 ll))))
- ll)))
- org-stored-links))
- (when (featurep 'org-id)
- (setq b (mapcar (lambda(l)
- (let ((ll (car l)))
- (when (and (string-match "^id:\\(.+\\)$" ll)
- (equal f (expand-file-name
- (or (org-id-find-id-file
- (match-string 1 ll)) ""))))
- ll)))
- org-stored-links)))
- (mapcar (lambda(l)
- (put-text-property 0 (length l) 'face 'font-lock-comment-face l))
- (delq nil (append a b)))))
- (defun org-link--buffer-for-internals ()
- "Return buffer used for displaying the target of internal links."
- (cond
- ((not org-link-use-indirect-buffer-for-internals) (current-buffer))
- ((string-suffix-p "(Clone)" (buffer-name))
- (message "Buffer is already a clone, not making another one")
- ;; We also do not modify visibility in this case.
- (current-buffer))
- (t ;make a new indirect buffer for displaying the link
- (let* ((indirect-buffer-name (concat (buffer-name) "(Clone)"))
- (indirect-buffer
- (or (get-buffer indirect-buffer-name)
- (make-indirect-buffer (current-buffer)
- indirect-buffer-name
- 'clone))))
- (with-current-buffer indirect-buffer (org-cycle-overview))
- indirect-buffer))))
- (defun org-link--search-radio-target (target)
- "Search a radio target matching TARGET in current buffer.
- White spaces are not significant."
- (let ((re (format "<<<%s>>>"
- (mapconcat #'regexp-quote
- (split-string target)
- "[ \t]+\\(?:\n[ \t]*\\)?")))
- (origin (point)))
- (goto-char (point-min))
- (catch :radio-match
- (while (re-search-forward re nil t)
- (forward-char -1)
- (let ((object (org-element-context)))
- (when (eq (org-element-type object) 'radio-target)
- (goto-char (org-element-property :begin object))
- (org-fold-show-context 'link-search)
- (throw :radio-match nil))))
- (goto-char origin)
- (user-error "No match for radio target: %s" target))))
- (defun org-link--context-from-region ()
- "Return context string from active region, or nil."
- (when (org-region-active-p)
- (let ((context (buffer-substring (region-beginning) (region-end))))
- (when (and (wholenump org-link-context-for-files)
- (> org-link-context-for-files 0))
- (let ((lines (org-split-string context "\n")))
- (setq context
- (mapconcat #'identity
- (cl-subseq lines 0 org-link-context-for-files)
- "\n"))))
- context)))
- (defun org-link--normalize-string (string &optional context)
- "Remove ignored contents from STRING string and return it.
- This function removes contiguous white spaces and statistics
- cookies. When optional argument CONTEXT is non-nil, it assumes
- STRING is a context string, and also removes special search
- syntax around the string."
- (let ((string
- (org-trim
- (replace-regexp-in-string
- (rx (one-or-more (any " \t")))
- " "
- (replace-regexp-in-string
- ;; Statistics cookie regexp.
- (rx (seq "[" (0+ digit) (or "%" (seq "/" (0+ digit))) "]"))
- " "
- string)))))
- (when context
- (while (cond ((and (string-prefix-p "(" string)
- (string-suffix-p ")" string))
- (setq string (org-trim (substring string 1 -1))))
- ((string-match "\\`[#*]+[ \t]*" string)
- (setq string (substring string (match-end 0))))
- (t nil))))
- string))
- (defun org-link--reveal-maybe (region _)
- "Reveal folded link in REGION when needed.
- This function is intended to be used as :fragile property of a folding
- spec."
- (org-with-point-at (car region)
- (not (org-in-regexp org-link-any-re))))
- ;;; Public API
- (defun org-link-types ()
- "Return a list of known link types."
- (mapcar #'car org-link-parameters))
- (defun org-link-get-parameter (type key)
- "Get TYPE link property for KEY.
- TYPE is a string and KEY is a plist keyword. See
- `org-link-parameters' for supported keywords."
- (plist-get (cdr (assoc type org-link-parameters))
- key))
- (defun org-link-set-parameters (type &rest parameters)
- "Set link TYPE properties to PARAMETERS.
- PARAMETERS should be keyword value pairs. See
- `org-link-parameters' for supported keys."
- (when (member type '("coderef" "custom-id" "fuzzy" "radio"))
- (error "Cannot override reserved link type: %S" type))
- (let ((data (assoc type org-link-parameters)))
- (if data (setcdr data (org-combine-plists (cdr data) parameters))
- (push (cons type parameters) org-link-parameters)
- (org-link-make-regexps)
- (when (featurep 'org-element) (org-element-update-syntax)))))
- (defun org-link-make-regexps ()
- "Update the link regular expressions.
- This should be called after the variable `org-link-parameters' has changed."
- (let ((types-re (regexp-opt (org-link-types) t)))
- (setq org-link-types-re
- (concat "\\`" types-re ":")
- org-link-angle-re
- (format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>"
- types-re)
- org-link-plain-re
- (let* ((non-space-bracket "[^][ \t\n()<>]")
- (parenthesis
- `(seq "("
- (0+ (or (regex ,non-space-bracket)
- (seq "("
- (0+ (regex ,non-space-bracket))
- ")")))
- ")")))
- ;; Heuristics for an URL link inspired by
- ;; https://daringfireball.net/2010/07/improved_regex_for_matching_urls
- (rx-to-string
- `(seq word-start
- ;; Link type: match group 1.
- (regexp ,types-re)
- ":"
- ;; Link path: match group 2.
- (group
- (1+ (or (regex ,non-space-bracket)
- ,parenthesis))
- (or (regexp "[^[:punct:] \t\n]")
- ?/
- ,parenthesis)))))
- org-link-bracket-re
- (rx (seq "[["
- ;; URI part: match group 1.
- (group
- (one-or-more
- (or (not (any "[]\\"))
- (and "\\" (zero-or-more "\\\\") (any "[]"))
- (and (one-or-more "\\") (not (any "[]"))))))
- "]"
- ;; Description (optional): match group 2.
- (opt "[" (group (+? anything)) "]")
- "]"))
- org-link-any-re
- (concat "\\(" org-link-bracket-re "\\)\\|\\("
- org-link-angle-re "\\)\\|\\("
- org-link-plain-re "\\)"))))
- (defun org-link-complete-file (&optional arg)
- "Create a file link using completion."
- (let ((file (read-file-name "File: "))
- (pwd (file-name-as-directory (expand-file-name ".")))
- (pwd1 (file-name-as-directory (abbreviate-file-name
- (expand-file-name ".")))))
- (cond ((equal arg '(16))
- (concat "file:"
- (abbreviate-file-name (expand-file-name file))))
- ((string-match
- (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
- (concat "file:" (match-string 1 file)))
- ((string-match
- (concat "^" (regexp-quote pwd) "\\(.+\\)")
- (expand-file-name file))
- (concat "file:"
- (match-string 1 (expand-file-name file))))
- (t (concat "file:" file)))))
- (defun org-link-email-description (&optional fmt)
- "Return the description part of an email link.
- This takes information from `org-store-link-plist' and formats it
- according to FMT (default from `org-link-email-description-format')."
- (setq fmt (or fmt org-link-email-description-format))
- (let* ((p org-store-link-plist)
- (to (plist-get p :toaddress))
- (from (plist-get p :fromaddress))
- (table
- (list
- (cons "%c" (plist-get p :fromto))
- (cons "%F" (plist-get p :from))
- (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?"))
- (cons "%T" (plist-get p :to))
- (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?"))
- (cons "%s" (plist-get p :subject))
- (cons "%d" (plist-get p :date))
- (cons "%m" (plist-get p :message-id)))))
- (when (string-match "%c" fmt)
- ;; Check if the user wrote this message
- (if (and org-link-from-user-regexp from to
- (save-match-data (string-match org-link-from-user-regexp from)))
- (setq fmt (replace-match "to %t" t t fmt))
- (setq fmt (replace-match "from %f" t t fmt))))
- (org-replace-escapes fmt table)))
- (defun org-link-store-props (&rest plist)
- "Store link properties.
- The properties are pre-processed by extracting names, addresses
- and dates."
- (let ((x (plist-get plist :from)))
- (when x
- (let ((adr (mail-extract-address-components x)))
- (setq plist (plist-put plist :fromname (car adr)))
- (setq plist (plist-put plist :fromaddress (nth 1 adr))))))
- (let ((x (plist-get plist :to)))
- (when x
- (let ((adr (mail-extract-address-components x)))
- (setq plist (plist-put plist :toname (car adr)))
- (setq plist (plist-put plist :toaddress (nth 1 adr))))))
- (let ((x (ignore-errors (date-to-time (plist-get plist :date)))))
- (when x
- (setq plist (plist-put plist :date-timestamp
- (format-time-string
- (org-time-stamp-format t) x)))
- (setq plist (plist-put plist :date-timestamp-inactive
- (format-time-string
- (org-time-stamp-format t t) x)))))
- (let ((from (plist-get plist :from))
- (to (plist-get plist :to)))
- (when (and from to org-link-from-user-regexp)
- (setq plist
- (plist-put plist :fromto
- (if (string-match org-link-from-user-regexp from)
- (concat "to %t")
- (concat "from %f"))))))
- (setq org-store-link-plist plist))
- (defun org-link-add-props (&rest plist)
- "Add these properties to the link property list."
- (let (key value)
- (while plist
- (setq key (pop plist) value (pop plist))
- (setq org-store-link-plist
- (plist-put org-store-link-plist key value)))))
- (defun org-link-encode (text table)
- "Return percent escaped representation of string TEXT.
- TEXT is a string with the text to escape. TABLE is a list of
- characters that should be escaped."
- (mapconcat
- (lambda (c)
- (if (memq c table)
- (mapconcat (lambda (e) (format "%%%.2X" e))
- (or (encode-coding-char c 'utf-8)
- (error "Unable to percent escape character: %c" c))
- "")
- (char-to-string c)))
- text ""))
- (defun org-link-decode (s)
- "Decode percent-encoded parts in string S.
- E.g. \"%C3%B6\" becomes the German o-Umlaut."
- (replace-regexp-in-string "\\(%[0-9A-Za-z]\\{2\\}\\)+"
- #'org-link--decode-compound s t t))
- (defun org-link-escape (link)
- "Backslash-escape sensitive characters in string LINK."
- (replace-regexp-in-string
- (rx (seq (group (zero-or-more "\\")) (group (or string-end (any "[]")))))
- (lambda (m)
- (concat (match-string 1 m)
- (match-string 1 m)
- (and (/= (match-beginning 2) (match-end 2)) "\\")))
- link nil t 1))
- (defun org-link-unescape (link)
- "Remove escaping backslash characters from string LINK."
- (replace-regexp-in-string
- (rx (group (one-or-more "\\")) (or string-end (any "[]")))
- (lambda (_)
- (concat (make-string (/ (- (match-end 1) (match-beginning 1)) 2) ?\\)))
- link nil t 1))
- (defun org-link-make-string (link &optional description)
- "Make a bracket link, consisting of LINK and DESCRIPTION.
- LINK is escaped with backslashes for inclusion in buffer."
- (let* ((zero-width-space (string ?\x200B))
- (description
- (and (org-string-nw-p description)
- ;; Description cannot contain two consecutive square
- ;; brackets, or end with a square bracket. To prevent
- ;; this, insert a zero width space character between
- ;; the brackets, or at the end of the description.
- (replace-regexp-in-string
- "\\(]\\)\\(]\\)"
- (concat "\\1" zero-width-space "\\2")
- (replace-regexp-in-string "]\\'"
- (concat "\\&" zero-width-space)
- (org-trim description))))))
- (if (not (org-string-nw-p link))
- (or description
- (error "Empty link"))
- (format "[[%s]%s]"
- (org-link-escape link)
- (if description (format "[%s]" description) "")))))
- (defun org-store-link-functions ()
- "List of functions that are called to create and store a link.
- The functions are defined in the `:store' property of
- `org-link-parameters'.
- Each function will be called in turn until one returns a non-nil
- value. Each function should check if it is responsible for
- creating this link (for example by looking at the major mode).
- If not, it must exit and return nil. If yes, it should return
- a non-nil value after calling `org-link-store-props' with a list
- of properties and values. Special properties are:
- :type The link prefix, like \"http\". This must be given.
- :link The link, like \"http://www.astro.uva.nl/~dominik\".
- This is obligatory as well.
- :description Optional default description for the second pair
- of brackets in an Org mode link. The user can still change
- this when inserting this link into an Org mode buffer.
- In addition to these, any additional properties can be specified
- and then used in capture templates."
- (cl-loop for link in org-link-parameters
- with store-func
- do (setq store-func (org-link-get-parameter (car link) :store))
- if store-func
- collect store-func))
- (defun org-link-expand-abbrev (link)
- "Replace link abbreviations in LINK string.
- Abbreviations are defined in `org-link-abbrev-alist'."
- (if (not (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link)) link
- (let* ((key (match-string 1 link))
- (as (or (assoc key org-link-abbrev-alist-local)
- (assoc key org-link-abbrev-alist)))
- (tag (and (match-end 2) (match-string 3 link)))
- rpl)
- (if (not as)
- link
- (setq rpl (cdr as))
- (cond
- ((symbolp rpl) (funcall rpl tag))
- ((string-match "%(\\([^)]+\\))" rpl)
- (replace-match
- (save-match-data
- (funcall (intern-soft (match-string 1 rpl)) tag))
- t t rpl))
- ((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
- ((string-match "%h" rpl)
- (replace-match (url-hexify-string (or tag "")) t t rpl))
- (t (concat rpl tag)))))))
- (defun org-link-open (link &optional arg)
- "Open a link object LINK.
- ARG is an optional prefix argument. Some link types may handle
- it. For example, it determines what application to run when
- opening a \"file\" link.
- Functions responsible for opening the link are either hard-coded
- for internal and \"file\" links, or stored as a parameter in
- `org-link-parameters', which see."
- (let ((type (org-element-property :type link))
- (path (org-element-property :path link)))
- (pcase type
- ;; Opening a "file" link requires special treatment since we
- ;; first need to integrate search option, if any.
- ("file"
- (let* ((option (org-element-property :search-option link))
- (path (if option (concat path "::" option) path)))
- (org-link-open-as-file path
- (pcase (org-element-property :application link)
- ((guard arg) arg)
- ("emacs" 'emacs)
- ("sys" 'system)))))
- ;; Internal links.
- ((or "coderef" "custom-id" "fuzzy" "radio")
- (unless (run-hook-with-args-until-success 'org-open-link-functions path)
- (if (not arg) (org-mark-ring-push)
- (switch-to-buffer-other-window (org-link--buffer-for-internals)))
- (let ((destination
- (org-with-wide-buffer
- (if (equal type "radio")
- (org-link--search-radio-target path)
- (org-link-search
- (pcase type
- ("custom-id" (concat "#" path))
- ("coderef" (format "(%s)" path))
- (_ path))
- ;; Prevent fuzzy links from matching themselves.
- (and (equal type "fuzzy")
- (+ 2 (org-element-property :begin link)))))
- (point))))
- (unless (and (<= (point-min) destination)
- (>= (point-max) destination))
- (widen))
- (goto-char destination))))
- (_
- ;; Look for a dedicated "follow" function in custom links.
- (let ((f (org-link-get-parameter type :follow)))
- (when (functionp f)
- ;; Function defined in `:follow' parameter may use a single
- ;; argument, as it was mandatory before Org 9.4. This is
- ;; deprecated, but support it for now.
- (condition-case nil
- (funcall (org-link-get-parameter type :follow) path arg)
- (wrong-number-of-arguments
- (funcall (org-link-get-parameter type :follow) path)))))))))
- (defun org-link-open-from-string (s &optional arg)
- "Open a link in the string S, as if it was in Org mode.
- Optional argument is passed to `org-open-file' when S is
- a \"file\" link."
- (interactive "sLink: \nP")
- (pcase (with-temp-buffer
- (let ((org-inhibit-startup nil))
- (insert s)
- (org-mode)
- (goto-char (point-min))
- (org-element-link-parser)))
- (`nil (user-error "No valid link in %S" s))
- (link (org-link-open link arg))))
- (defun org-link-search (s &optional avoid-pos stealth)
- "Search for a search string S.
- If S starts with \"#\", it triggers a custom ID search.
- If S is enclosed within parenthesis, it initiates a coderef
- search.
- If S is surrounded by forward slashes, it is interpreted as
- a regular expression. In Org mode files, this will create an
- `org-occur' sparse tree. In ordinary files, `occur' will be used
- to list matches. If the current buffer is in `dired-mode', grep
- will be used to search in all files.
- When AVOID-POS is given, ignore matches near that position.
- When optional argument STEALTH is non-nil, do not modify
- visibility around point, thus ignoring `org-show-context-detail'
- variable.
- Search is case-insensitive and ignores white spaces. Return type
- of matched result, which is either `dedicated' or `fuzzy'."
- (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s))
- (let* ((case-fold-search t)
- (origin (point))
- (normalized (replace-regexp-in-string "\n[ \t]*" " " s))
- (starred (eq (string-to-char normalized) ?*))
- (words (split-string (if starred (substring s 1) s)))
- (s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)"))
- (s-single-re (mapconcat #'regexp-quote words "[ \t]+"))
- type)
- (cond
- ;; Check if there are any special search functions.
- ((run-hook-with-args-until-success 'org-execute-file-search-functions s))
- ((eq (string-to-char s) ?#)
- ;; Look for a custom ID S if S starts with "#".
- (let* ((id (substring normalized 1))
- (match (org-find-property "CUSTOM_ID" id)))
- (if match (progn (goto-char match) (setf type 'dedicated))
- (error "No match for custom ID: %s" id))))
- ((string-match "\\`(\\(.*\\))\\'" normalized)
- ;; Look for coderef targets if S is enclosed within parenthesis.
- (let ((coderef (match-string-no-properties 1 normalized))
- (re (substring s-single-re 1 -1)))
- (goto-char (point-min))
- (catch :coderef-match
- (while (re-search-forward re nil t)
- (let ((element (org-element-at-point)))
- (when (and (memq (org-element-type element)
- '(example-block src-block))
- (org-match-line
- (concat ".*?" (org-src-coderef-regexp
- (org-src-coderef-format element)
- coderef))))
- (setq type 'dedicated)
- (goto-char (match-beginning 2))
- (throw :coderef-match nil))))
- (goto-char origin)
- (error "No match for coderef: %s" coderef))))
- ((string-match "\\`/\\(.*\\)/\\'" normalized)
- ;; Look for a regular expression.
- (funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur)
- (match-string 1 s)))
- ;; From here, we handle fuzzy links.
- ;;
- ;; Look for targets, only if not in a headline search.
- ((and (not starred)
- (let ((target (format "<<%s>>" s-multi-re)))
- (catch :target-match
- (goto-char (point-min))
- (while (re-search-forward target nil t)
- (backward-char)
- (let ((context (org-element-context)))
- (when (eq (org-element-type context) 'target)
- (setq type 'dedicated)
- (goto-char (org-element-property :begin context))
- (throw :target-match t))))
- nil))))
- ;; Look for elements named after S, only if not in a headline
- ;; search.
- ((and (not starred)
- (let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re)))
- (catch :name-match
- (goto-char (point-min))
- (while (re-search-forward name nil t)
- (let* ((element (org-element-at-point))
- (name (org-element-property :name element)))
- (when (and name (equal words (split-string name)))
- (setq type 'dedicated)
- (beginning-of-line)
- (throw :name-match t))))
- nil))))
- ;; Regular text search. Prefer headlines in Org mode buffers.
- ;; Ignore COMMENT keyword, TODO keywords, priority cookies,
- ;; statistics cookies and tags.
- ((and (derived-mode-p 'org-mode)
- (let ((title-re
- (format "%s.*\\(?:%s[ \t]\\)?.*%s"
- org-outline-regexp-bol
- org-comment-string
- (mapconcat #'regexp-quote words ".+"))))
- (goto-char (point-min))
- (catch :found
- (while (re-search-forward title-re nil t)
- (when (equal words
- (split-string
- (org-link--normalize-string
- (org-get-heading t t t t))))
- (throw :found t)))
- nil)))
- (beginning-of-line)
- (setq type 'dedicated))
- ;; Offer to create non-existent headline depending on
- ;; `org-link-search-must-match-exact-headline'.
- ((and (derived-mode-p 'org-mode)
- (eq org-link-search-must-match-exact-headline 'query-to-create)
- (yes-or-no-p "No match - create this as a new heading? "))
- (goto-char (point-max))
- (unless (bolp) (newline))
- (org-insert-heading nil t t)
- (insert s "\n")
- (beginning-of-line 0))
- ;; Only headlines are looked after. No need to process
- ;; further: throw an error.
- ((and (derived-mode-p 'org-mode)
- (or starred org-link-search-must-match-exact-headline))
- (goto-char origin)
- (error "No match for fuzzy expression: %s" normalized))
- ;; Regular text search.
- ((catch :fuzzy-match
- (goto-char (point-min))
- (while (re-search-forward s-multi-re nil t)
- ;; Skip match if it contains AVOID-POS or it is included in
- ;; a link with a description but outside the description.
- (unless (or (and avoid-pos
- (<= (match-beginning 0) avoid-pos)
- (> (match-end 0) avoid-pos))
- (and (save-match-data
- (org-in-regexp org-link-bracket-re))
- (match-beginning 3)
- (or (> (match-beginning 3) (point))
- (<= (match-end 3) (point)))
- (org-element-lineage
- (save-match-data (org-element-context))
- '(link) t)))
- (goto-char (match-beginning 0))
- (setq type 'fuzzy)
- (throw :fuzzy-match t)))
- nil))
- ;; All failed. Throw an error.
- (t (goto-char origin)
- (error "No match for fuzzy expression: %s" normalized)))
- ;; Disclose surroundings of match, if appropriate.
- (when (and (derived-mode-p 'org-mode) (not stealth))
- (org-fold-show-context 'link-search))
- type))
- (defun org-link-heading-search-string (&optional string)
- "Make search string for the current headline or STRING.
- Search string starts with an asterisk. COMMENT keyword and
- statistics cookies are removed, and contiguous spaces are packed
- into a single one.
- When optional argument STRING is non-nil, assume it a headline,
- without any asterisk, TODO or COMMENT keyword, and without any
- priority cookie or tag."
- (concat "*"
- (org-link--normalize-string
- (or string (org-get-heading t t t t)))))
- (defun org-link-open-as-file (path arg)
- "Pretend PATH is a file name and open it.
- According to \"file\"-link syntax, PATH may include additional
- search options, separated from the file name with \"::\".
- This function is meant to be used as a possible tool for
- `:follow' property in `org-link-parameters'."
- (let* ((option (and (string-match "::\\(.*\\)\\'" path)
- (match-string 1 path)))
- (file-name (if (not option) path
- (substring path 0 (match-beginning 0)))))
- (if (string-match "[*?{]" (file-name-nondirectory file-name))
- (dired file-name)
- (apply #'org-open-file
- file-name
- arg
- (cond ((not option) nil)
- ((string-match-p "\\`[0-9]+\\'" option)
- (list (string-to-number option)))
- (t (list nil option)))))))
- (defun org-link-display-format (s)
- "Replace links in string S with their description.
- If there is no description, use the link target."
- (save-match-data
- (replace-regexp-in-string
- org-link-bracket-re
- (lambda (m) (or (match-string 2 m) (match-string 1 m)))
- s nil t)))
- (defun org-link-add-angle-brackets (s)
- "Wrap string S within angle brackets."
- (unless (equal (substring s 0 1) "<") (setq s (concat "<" s)))
- (unless (equal (substring s -1) ">") (setq s (concat s ">")))
- s)
- ;;; Built-in link types
- ;;;; "elisp" link type
- (defun org-link--open-elisp (path _)
- "Open a \"elisp\" type link.
- PATH is the sexp to evaluate, as a string."
- (if (or (and (org-string-nw-p org-link-elisp-skip-confirm-regexp)
- (string-match-p org-link-elisp-skip-confirm-regexp path))
- (not org-link-elisp-confirm-function)
- (funcall org-link-elisp-confirm-function
- (format "Execute %s as Elisp? "
- (org-add-props path nil 'face 'org-warning))))
- (message "%s => %s" path
- (if (eq ?\( (string-to-char path))
- (eval (read path))
- (call-interactively (read path))))
- (user-error "Abort")))
- (org-link-set-parameters "elisp" :follow #'org-link--open-elisp)
- ;;;; "file" link type
- (org-link-set-parameters "file" :complete #'org-link-complete-file)
- ;;;; "help" link type
- (defun org-link--open-help (path _)
- "Open a \"help\" type link.
- PATH is a symbol name, as a string."
- (pcase (intern path)
- ((and (pred fboundp) function) (describe-function function))
- ((and (pred boundp) variable) (describe-variable variable))
- (name (user-error "Unknown function or variable: %s" name))))
- (defun org-link--store-help ()
- "Store \"help\" type link."
- (when (eq major-mode 'help-mode)
- (let ((symbol
- (save-excursion
- (goto-char (point-min))
- ;; In case the help is about the key-binding, store the
- ;; function instead.
- (search-forward "runs the command " (line-end-position) t)
- (read (current-buffer)))))
- (org-link-store-props :type "help"
- :link (format "help:%s" symbol)
- :description nil))))
- (org-link-set-parameters "help"
- :follow #'org-link--open-help
- :store #'org-link--store-help)
- ;;;; "http", "https", "mailto", "ftp", and "news" link types
- (dolist (scheme '("ftp" "http" "https" "mailto" "news"))
- (org-link-set-parameters scheme
- :follow
- (lambda (url arg)
- (browse-url (concat scheme ":" url) arg))))
- ;;;; "shell" link type
- (defun org-link--open-shell (path _)
- "Open a \"shell\" type link.
- PATH is the command to execute, as a string."
- (if (or (and (org-string-nw-p org-link-shell-skip-confirm-regexp)
- (string-match-p org-link-shell-skip-confirm-regexp path))
- (not org-link-shell-confirm-function)
- (funcall org-link-shell-confirm-function
- (format "Execute %s in shell? "
- (org-add-props path nil 'face 'org-warning))))
- (let ((buf (generate-new-buffer "*Org Shell Output*")))
- (message "Executing %s" path)
- (shell-command path buf)
- (when (featurep 'midnight)
- (setq clean-buffer-list-kill-buffer-names
- (cons (buffer-name buf)
- clean-buffer-list-kill-buffer-names))))
- (user-error "Abort")))
- (org-link-set-parameters "shell" :follow #'org-link--open-shell)
- ;;; Interactive Functions
- ;;;###autoload
- (defun org-next-link (&optional search-backward)
- "Move forward to the next link.
- If the link is in hidden text, expose it. When SEARCH-BACKWARD
- is non-nil, move backward."
- (interactive)
- (let ((pos (point))
- (search-fun (if search-backward #'re-search-backward
- #'re-search-forward)))
- ;; Tweak initial position. If last search failed, wrap around.
- ;; Otherwise, make sure we do not match current link.
- (cond
- ((not (and org-link--search-failed (eq this-command last-command)))
- (cond
- ((and (not search-backward) (looking-at org-link-any-re))
- (goto-char (match-end 0)))
- (search-backward
- (pcase (org-in-regexp org-link-any-re nil t)
- (`(,beg . ,_) (goto-char beg))
- (_ nil)))
- (t nil)))
- (search-backward
- (goto-char (point-max))
- (message "Link search wrapped back to end of buffer"))
- (t
- (goto-char (point-min))
- (message "Link search wrapped back to beginning of buffer")))
- (setq org-link--search-failed nil)
- (catch :found
- (while (funcall search-fun org-link-any-re nil t)
- (let ((context (save-excursion
- (unless search-backward (forward-char -1))
- (org-element-context))))
- (pcase (org-element-lineage context '(link) t)
- (`nil nil)
- (link
- (goto-char (org-element-property :begin link))
- (when (org-invisible-p) (org-fold-show-context 'link-search))
- (throw :found t)))))
- (goto-char pos)
- (setq org-link--search-failed t)
- (message "No further link found"))))
- ;;;###autoload
- (defun org-previous-link ()
- "Move backward to the previous link.
- If the link is in hidden text, expose it."
- (interactive)
- (org-next-link t))
- (defun org-link-descriptive-ensure ()
- "Toggle the literal or descriptive display of links in current buffer if needed."
- (if org-link-descriptive
- (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible nil)
- (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible t)))
- ;;;###autoload
- (defun org-toggle-link-display ()
- "Toggle the literal or descriptive display of links in current buffer."
- (interactive)
- (setq org-link-descriptive (not org-link-descriptive))
- (org-link-descriptive-ensure))
- ;;;###autoload
- (defun org-store-link (arg &optional interactive?)
- "Store a link to the current location.
- \\<org-mode-map>
- This link is added to `org-stored-links' and can later be inserted
- into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
- For some link types, a `\\[universal-argument]' prefix ARG is interpreted. \
- A single
- `\\[universal-argument]' negates `org-context-in-file-links' for file links or
- `org-gnus-prefer-web-links' for links to Usenet articles.
- A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \
- skipping storing functions that are not
- part of Org core.
- A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
- prefix ARG forces storing a link for each line in the
- active region.
- Assume the function is called interactively if INTERACTIVE? is
- non-nil."
- (interactive "P\np")
- (org-load-modules-maybe)
- (if (and (equal arg '(64)) (org-region-active-p))
- (save-excursion
- (let ((end (region-end)))
- (goto-char (region-beginning))
- (set-mark (point))
- (while (< (line-end-position) end)
- (move-end-of-line 1) (activate-mark)
- (let (current-prefix-arg)
- (call-interactively 'org-store-link))
- (move-beginning-of-line 2)
- (set-mark (point)))))
- (setq org-store-link-plist nil)
- (let (link cpltxt desc search custom-id agenda-link) ;; description
- (cond
- ;; Store a link using an external link type, if any function is
- ;; available. If more than one can generate a link from current
- ;; location, ask which one to use.
- ((and (not (equal arg '(16)))
- (let ((results-alist nil))
- (dolist (f (org-store-link-functions))
- (when (funcall f)
- ;; XXX: return value is not link's plist, so we
- ;; store the new value before it is modified. It
- ;; would be cleaner to ask store link functions to
- ;; return the plist instead.
- (push (cons f (copy-sequence org-store-link-plist))
- results-alist)))
- (pcase results-alist
- (`nil nil)
- (`((,_ . ,_)) t) ;single choice: nothing to do
- (`((,name . ,_) . ,_)
- ;; Reinstate link plist associated to the chosen
- ;; function.
- (apply #'org-link-store-props
- (cdr (assoc-string
- (completing-read
- (format "Store link with (default %s): " name)
- (mapcar #'car results-alist)
- nil t nil nil (symbol-name name))
- results-alist)))
- t))))
- (setq link (plist-get org-store-link-plist :link))
- ;; If store function actually set `:description' property, use
- ;; it, even if it is nil. Otherwise, fallback to nil (ask user).
- (setq desc (plist-get org-store-link-plist :description)))
- ;; Store a link from a remote editing buffer.
- ((org-src-edit-buffer-p)
- (let ((coderef-format (org-src-coderef-format))
- (format-link
- (lambda (label)
- (if org-src-source-file-name
- (format "file:%s::(%s)" org-src-source-file-name label)
- (format "(%s)" label)))))
- (cond
- ;; Code references do not exist in this type of buffer.
- ;; Pretend we're linking from the source buffer directly.
- ((not (memq (org-src-source-type) '(example-block src-block)))
- (with-current-buffer (org-src-source-buffer)
- (org-store-link arg interactive?))
- (setq link nil))
- ;; A code reference exists. Use it.
- ((save-excursion
- (beginning-of-line)
- (re-search-forward (org-src-coderef-regexp coderef-format)
- (line-end-position)
- t))
- (setq link (funcall format-link (match-string-no-properties 3))))
- ;; No code reference. Create a new one then store the link
- ;; to it, but only in the function is called interactively.
- (interactive?
- (end-of-line)
- (let* ((label (read-string "Code line label: "))
- (reference (format coderef-format label))
- (gc (- 79 (length reference))))
- (if (< (current-column) gc)
- (org-move-to-column gc t)
- (insert " "))
- (insert reference)
- (setq link (funcall format-link label))))
- ;; No code reference, and non-interactive call. Don't know
- ;; what to do. Give up.
- (t (setq link nil)))))
- ;; We are in the agenda, link to referenced location
- ((eq major-mode 'org-agenda-mode)
- (let ((m (or (get-text-property (point) 'org-hd-marker)
- (get-text-property (point) 'org-marker))))
- (when m
- (org-with-point-at m
- (setq agenda-link (org-store-link nil interactive?))))))
- ((eq major-mode 'calendar-mode)
- (let ((cd (calendar-cursor-to-date)))
- (setq link
- (format-time-string
- (car org-time-stamp-formats)
- (org-encode-time 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd))))
- (org-link-store-props :type "calendar" :date cd)))
- ((eq major-mode 'image-mode)
- (setq cpltxt (concat "file:"
- (abbreviate-file-name buffer-file-name))
- link cpltxt)
- (org-link-store-props :type "image" :file buffer-file-name))
- ;; In dired, store a link to the file of the current line
- ((derived-mode-p 'dired-mode)
- (let ((file (dired-get-filename nil t)))
- (setq file (if file
- (abbreviate-file-name
- (expand-file-name (dired-get-filename nil t)))
- ;; Otherwise, no file so use current directory.
- default-directory))
- (setq cpltxt (concat "file:" file)
- link cpltxt)))
- ((setq search (run-hook-with-args-until-success
- 'org-create-file-search-functions))
- (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
- "::" search))
- (setq cpltxt (or link))) ;; description
- ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
- (org-with-limited-levels
- (setq custom-id (org-entry-get nil "CUSTOM_ID"))
- (cond
- ;; Store a link using the target at point
- ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
- (setq link
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))
- "::" (match-string 1))
- ;; Target may be shortened when link is inserted.
- ;; Avoid [[target][file:~/org/test.org::target]]
- ;; links. Maybe the case of identical target and
- ;; description should be handled by `org-insert-link'.
- cpltxt nil
- desc nil
- ;; Do not append #CUSTOM_ID link below.
- custom-id nil))
- ((and (featurep 'org-id)
- (or (eq org-id-link-to-org-use-id t)
- (and interactive?
- (or (eq org-id-link-to-org-use-id 'create-if-interactive)
- (and (eq org-id-link-to-org-use-id
- 'create-if-interactive-and-no-custom-id)
- (not custom-id))))
- (and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
- ;; Store a link using the ID at point
- (setq link (condition-case nil
- (prog1 (org-id-store-link)
- (setq desc (plist-get org-store-link-plist :description)))
- (error
- ;; Probably before first headline, link only to file
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer))))))))
- (t
- ;; Just link to current headline.
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context search string.
- (when (org-xor org-link-context-for-files (equal arg '(4)))
- (let* ((element (org-element-at-point))
- (name (org-element-property :name element))
- (context
- (cond
- ((let ((region (org-link--context-from-region)))
- (and region (org-link--normalize-string region t))))
- (name)
- ((org-before-first-heading-p)
- (org-link--normalize-string (org-current-line-string) t))
- (t (org-link-heading-search-string)))))
- (when (org-string-nw-p context)
- (setq cpltxt (format "%s::%s" cpltxt context))
- (setq desc
- (or name
- ;; Although description is not a search
- ;; string, use `org-link--normalize-string'
- ;; to prettify it (contiguous white spaces)
- ;; and remove volatile contents (statistics
- ;; cookies).
- (and (not (org-before-first-heading-p))
- (org-link--normalize-string
- (org-get-heading t t t t)))
- "NONE")))))
- (setq link cpltxt)))))
- ((buffer-file-name (buffer-base-buffer))
- ;; Just link to this file here.
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context search string.
- (when (org-xor org-link-context-for-files (equal arg '(4)))
- (let ((context (org-link--normalize-string
- (or (org-link--context-from-region)
- (org-current-line-string))
- t)))
- ;; Only use search option if there is some text.
- (when (org-string-nw-p context)
- (setq cpltxt (format "%s::%s" cpltxt context))
- (setq desc "NONE"))))
- (setq link cpltxt))
- (interactive?
- (user-error "No method for storing a link from this buffer"))
- (t (setq link nil)))
- ;; We're done setting link and desc, clean up
- (when (consp link) (setq cpltxt (car link) link (cdr link)))
- (setq link (or link cpltxt))
- (cond ((not desc))
- ((equal desc "NONE") (setq desc nil))
- (t (setq desc (org-link-display-format desc))))
- ;; Store and return the link
- (if (not (and interactive? link))
- (or agenda-link (and link (org-link-make-string link desc)))
- (if (member (list link desc) org-stored-links)
- (message "This link has already been stored")
- (push (list link desc) org-stored-links)
- (message "Stored: %s" (or desc link))
- (when custom-id
- (setq link (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))
- "::#" custom-id))
- (push (list link desc) org-stored-links)))
- (car org-stored-links)))))
- ;;;###autoload
- (defun org-insert-link (&optional complete-file link-location description)
- "Insert a link. At the prompt, enter the link.
- Completion can be used to insert any of the link protocol prefixes in use.
- The history can be used to select a link previously stored with
- `org-store-link'. When the empty string is entered (i.e. if you just
- press `RET' at the prompt), the link defaults to the most recently
- stored link. As `SPC' triggers completion in the minibuffer, you need to
- use `M-SPC' or `C-q SPC' to force the insertion of a space character.
- Completion candidates include link descriptions.
- If there is a link under cursor then edit it.
- You will also be prompted for a description, and if one is given, it will
- be displayed in the buffer instead of the link.
- If there is already a link at point, this command will allow you to edit
- link and description parts.
- With a `\\[universal-argument]' prefix, prompts for a file to link to. The \
- file name can be
- selected using completion. The path to the file will be relative to the
- current directory if the file is in the current directory or a subdirectory.
- Otherwise, the link will be the absolute path as completed in the minibuffer
- \(i.e. normally ~/path/to/file). You can configure this behavior using the
- option `org-link-file-path-type'.
- With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \
- absolute path even if the file is in
- the current directory or below.
- A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
- prefix negates `org-link-keep-stored-after-insertion'.
- If the LINK-LOCATION parameter is non-nil, this value will be used as
- the link location instead of reading one interactively.
- If the DESCRIPTION parameter is non-nil, this value will be used
- as the default description. If not, and the chosen link type has
- a non-nil `:insert-description' parameter, that is used to
- generate a description as described in `org-link-parameters'
- docstring. Otherwise, if `org-link-make-description-function' is
- non-nil, this function will be called with the link target, and
- the result will be the default link description. When called
- non-interactively, don't allow to edit the default description."
- (interactive "P")
- (let* ((wcf (current-window-configuration))
- (origbuf (current-buffer))
- (region (when (org-region-active-p)
- (buffer-substring (region-beginning) (region-end))))
- (remove (and region (list (region-beginning) (region-end))))
- (desc region)
- (link link-location)
- (abbrevs org-link-abbrev-alist-local)
- (all-prefixes (append (mapcar #'car abbrevs)
- (mapcar #'car org-link-abbrev-alist)
- (org-link-types)))
- entry)
- (cond
- (link-location) ; specified by arg, just use it.
- ((org-in-regexp org-link-bracket-re 1)
- ;; We do have a link at point, and we are going to edit it.
- (setq remove (list (match-beginning 0) (match-end 0)))
- (setq desc (when (match-end 2) (match-string-no-properties 2)))
- (setq link (read-string "Link: "
- (org-link-unescape
- (match-string-no-properties 1)))))
- ((or (org-in-regexp org-link-angle-re)
- (org-in-regexp org-link-plain-re))
- ;; Convert to bracket link
- (setq remove (list (match-beginning 0) (match-end 0))
- link (read-string "Link: "
- (org-unbracket-string "<" ">" (match-string 0)))))
- ((member complete-file '((4) (16)))
- ;; Completing read for file names.
- (setq link (org-link-complete-file complete-file)))
- (t
- ;; Read link, with completion for stored links.
- (org-link--fontify-links-to-this-file)
- (org-switch-to-buffer-other-window "*Org Links*")
- (with-current-buffer "*Org Links*"
- (erase-buffer)
- (insert "Insert a link.
- Use TAB to complete link prefixes, then RET for type-specific completion support\n")
- (when org-stored-links
- (insert "\nStored links are available with <up>/<down> or M-p/n \
- \(most recent with RET):\n\n")
- (insert (mapconcat #'org-link--prettify
- (reverse org-stored-links)
- "\n")))
- (goto-char (point-min)))
- (when (get-buffer-window "*Org Links*" 'visible)
- (let ((cw (selected-window)))
- (select-window (get-buffer-window "*Org Links*" 'visible))
- (with-current-buffer "*Org Links*" (setq truncate-lines t))
- (unless (pos-visible-in-window-p (point-max))
- (org-fit-window-to-buffer))
- (and (window-live-p cw) (select-window cw))))
- (unwind-protect
- ;; Fake a link history, containing the stored links.
- (let ((org-link--history
- (append (mapcar #'car org-stored-links)
- org-link--insert-history)))
- (setq link
- (org-completing-read
- "Link: "
- (append
- (mapcar (lambda (x) (concat x ":")) all-prefixes)
- (mapcar #'car org-stored-links)
- ;; Allow description completion. Avoid "nil" option
- ;; in the case of `completing-read-default' and
- ;; an error in `ido-completing-read' when some links
- ;; have no description.
- (delq nil (mapcar 'cadr org-stored-links)))
- nil nil nil
- 'org-link--history
- (caar org-stored-links)))
- (unless (org-string-nw-p link) (user-error "No link selected"))
- (dolist (l org-stored-links)
- (when (equal link (cadr l))
- (setq link (car l))))
- (when (or (member link all-prefixes)
- (and (equal ":" (substring link -1))
- (member (substring link 0 -1) all-prefixes)
- (setq link (substring link 0 -1))))
- (setq link (with-current-buffer origbuf
- (org-link--try-special-completion link)))))
- (set-window-configuration wcf)
- (kill-buffer "*Org Links*"))
- (setq entry (assoc link org-stored-links))
- (or entry (push link org-link--insert-history))
- (setq desc (or desc (nth 1 entry)))))
- (when (funcall (if (equal complete-file '(64)) 'not 'identity)
- (not org-link-keep-stored-after-insertion))
- (setq org-stored-links (delq (assoc link org-stored-links)
- org-stored-links)))
- (when (and (string-match org-link-plain-re link)
- (not (string-match org-ts-regexp link)))
- ;; URL-like link, normalize the use of angular brackets.
- (setq link (org-unbracket-string "<" ">" link)))
- ;; Check if we are linking to the current file with a search
- ;; option If yes, simplify the link by using only the search
- ;; option.
- (when (and (buffer-file-name (buffer-base-buffer))
- (let ((case-fold-search nil))
- (string-match "\\`file:\\(.+?\\)::" link)))
- (let ((path (match-string-no-properties 1 link))
- (search (substring-no-properties link (match-end 0))))
- (save-match-data
- (when (equal (file-truename (buffer-file-name (buffer-base-buffer)))
- (file-truename path))
- ;; We are linking to this same file, with a search option
- (setq link search)))))
- ;; Check if we can/should use a relative path. If yes, simplify
- ;; the link.
- (let ((case-fold-search nil))
- (when (string-match "\\`\\(file\\|docview\\):" link)
- (let* ((type (match-string-no-properties 0 link))
- (path-start (match-end 0))
- (search (and (string-match "::\\(.*\\)\\'" link)
- (match-string 1 link)))
- (path
- (if search
- (substring-no-properties
- link path-start (match-beginning 0))
- (substring-no-properties link (match-end 0))))
- (origpath path))
- (cond
- ((or (eq org-link-file-path-type 'absolute)
- (equal complete-file '(16)))
- (setq path (abbreviate-file-name (expand-file-name path))))
- ((eq org-link-file-path-type 'noabbrev)
- (setq path (expand-file-name path)))
- ((eq org-link-file-path-type 'relative)
- (setq path (file-relative-name path)))
- ((functionp org-link-file-path-type)
- (setq path (funcall org-link-file-path-type
- (expand-file-name path))))
- (t
- (save-match-data
- (if (string-match (concat "^" (regexp-quote
- (expand-file-name
- (file-name-as-directory
- default-directory))))
- (expand-file-name path))
- ;; We are linking a file with relative path name.
- (setq path (substring (expand-file-name path)
- (match-end 0)))
- (setq path (abbreviate-file-name (expand-file-name path)))))))
- (setq link (concat type path (and search (concat "::" search))))
- (when (equal desc origpath)
- (setq desc path)))))
- (let* ((type
- (cond
- ((and all-prefixes
- (string-match (rx-to-string `(: string-start (submatch (or ,@all-prefixes)) ":")) link))
- (match-string 1 link))
- ((file-name-absolute-p link) "file")
- ((string-match "\\`\\.\\.?/" link) "file")))
- (initial-input
- (cond
- (description)
- (desc)
- ((org-link-get-parameter type :insert-description)
- (let ((def (org-link-get-parameter type :insert-description)))
- (condition-case nil
- (cond
- ((stringp def) def)
- ((functionp def)
- (funcall def link desc)))
- (error
- (message "Can't get link description from org link parameter `:insert-description': %S"
- def)
- (sit-for 2)
- nil))))
- (org-link-make-description-function
- (condition-case nil
- (funcall org-link-make-description-function link desc)
- (error
- (message "Can't get link description from %S"
- org-link-make-description-function)
- (sit-for 2)
- nil))))))
- (setq desc (if (called-interactively-p 'any)
- (read-string "Description: " initial-input)
- initial-input)))
- (unless (org-string-nw-p desc) (setq desc nil))
- (when remove (apply #'delete-region remove))
- (insert (org-link-make-string link desc))
- ;; Redisplay so as the new link has proper invisible characters.
- (sit-for 0)))
- ;;;###autoload
- (defun org-insert-all-links (arg &optional pre post)
- "Insert all links in `org-stored-links'.
- When a universal prefix, do not delete the links from `org-stored-links'.
- When `ARG' is a number, insert the last N link(s).
- `PRE' and `POST' are optional arguments to define a string to
- prepend or to append."
- (interactive "P")
- (let ((org-link-keep-stored-after-insertion (equal arg '(4)))
- (links (copy-sequence org-stored-links))
- (pr (or pre "- "))
- (po (or post "\n"))
- (cnt 1) l)
- (if (null org-stored-links)
- (message "No link to insert")
- (while (and (or (listp arg) (>= arg cnt))
- (setq l (if (listp arg)
- (pop links)
- (pop org-stored-links))))
- (setq cnt (1+ cnt))
- (insert pr)
- (org-insert-link nil (car l) (or (cadr l) "<no description>"))
- (insert po)))))
- ;;;###autoload
- (defun org-insert-last-stored-link (arg)
- "Insert the last link stored in `org-stored-links'."
- (interactive "p")
- (org-insert-all-links arg "" "\n"))
- ;;;###autoload
- (defun org-insert-link-global ()
- "Insert a link like Org mode does.
- This command can be called in any mode to insert a link in Org syntax."
- (interactive)
- (org-load-modules-maybe)
- (org-run-like-in-org-mode 'org-insert-link))
- ;;;###autoload
- (defun org-update-radio-target-regexp ()
- "Find all radio targets in this file and update the regular expression.
- Also refresh fontification if needed."
- (interactive)
- (let ((old-regexp org-target-link-regexp)
- ;; Some languages, e.g., Chinese, do not use spaces to
- ;; separate words. Also allow to surround radio targets with
- ;; line-breakable characters.
- (before-re "\\(?:^\\|[^[:alnum:]]\\|\\c|\\)\\(")
- (after-re "\\)\\(?:$\\|[^[:alnum:]]\\|\\c|\\)")
- (targets
- (org-with-wide-buffer
- (goto-char (point-min))
- (let (rtn)
- (while (re-search-forward org-radio-target-regexp nil t)
- ;; Make sure point is really within the object.
- (backward-char)
- (let ((obj (org-element-context)))
- (when (eq (org-element-type obj) 'radio-target)
- (cl-pushnew (org-element-property :value obj) rtn
- :test #'equal))))
- rtn))))
- (setq targets
- (sort targets
- (lambda (a b)
- (> (length a) (length b)))))
- (setq org-target-link-regexp
- (and targets
- (concat before-re
- (mapconcat
- (lambda (x)
- (replace-regexp-in-string
- " +" "\\s-+" (regexp-quote x) t t))
- targets
- "\\|")
- after-re)))
- (unless (equal old-regexp org-target-link-regexp)
- ;; Clean-up cache.
- (let ((regexp (cond ((not old-regexp) org-target-link-regexp)
- ((not org-target-link-regexp) old-regexp)
- (t
- (concat before-re
- (mapconcat
- (lambda (re)
- (substring re (length before-re)
- (- (length after-re))))
- (list old-regexp org-target-link-regexp)
- "\\|")
- after-re)))))
- (when (and (featurep 'org-element)
- (not (bound-and-true-p org-mode-loading)))
- (org-with-point-at 1
- (while (re-search-forward regexp nil t)
- (org-element-cache-refresh (match-beginning 1))))))
- ;; Re fontify buffer.
- (when (memq 'radio org-highlight-links)
- (org-restart-font-lock)))))
- ;;; Initialize Regexps
- (org-link-make-regexps)
- (provide 'ol)
- ;; Local variables:
- ;; generated-autoload-file: "org-loaddefs.el"
- ;; End:
- ;;; ol.el ends here
|