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