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