org-footnote.el (38546B)
1 ;;; org-footnote.el --- Footnote support in Org -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2009-2024 Free Software Foundation, Inc. 4 ;; 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, text 7 ;; URL: https://orgmode.org 8 ;; 9 ;; This file is part of GNU Emacs. 10 ;; 11 ;; GNU Emacs is free software: you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; GNU Emacs is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 ;; 25 ;;; Commentary: 26 27 ;; This file contains the code dealing with footnotes in Org mode. 28 29 ;;; Code: 30 31 (require 'org-macs) 32 (org-assert-version) 33 34 ;;;; Declarations 35 36 (require 'cl-lib) 37 (require 'org-macs) 38 (require 'org-compat) 39 40 (declare-function org-at-comment-p "org" ()) 41 (declare-function org-at-heading-p "org" (&optional ignored)) 42 (declare-function org-back-over-empty-lines "org" ()) 43 (declare-function org-end-of-meta-data "org" (&optional full)) 44 (declare-function org-edit-footnote-reference "org-src" ()) 45 (declare-function org-element-at-point "org-element" (&optional pom cached-only)) 46 (declare-function org-element-class "org-element" (datum &optional parent)) 47 (declare-function org-element-context "org-element" (&optional element)) 48 (declare-function org-element-lineage "org-element-ast" (blob &optional types with-self)) 49 (declare-function org-element-property "org-element-ast" (property node)) 50 (declare-function org-element-type "org-element-ast" (node &optional anonymous)) 51 (declare-function org-element-type-p "org-element-ast" (node types)) 52 (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) 53 (declare-function org-fill-paragraph "org" (&optional justify region)) 54 (declare-function org-in-block-p "org" (names)) 55 (declare-function org-in-verbatim-emphasis "org" ()) 56 (declare-function org-inside-LaTeX-fragment-p "org" ()) 57 (declare-function org-inside-latex-macro-p "org" ()) 58 (declare-function org-mark-ring-push "org" (&optional pos buffer)) 59 (declare-function org-fold-show-context "org-fold" (&optional key)) 60 (declare-function outline-next-heading "outline") 61 62 (defvar electric-indent-mode) 63 (defvar org-blank-before-new-entry) ; defined in org.el 64 (defvar org-link-bracket-re) ; defined in org.el 65 (defvar org-complex-heading-regexp) ; defined in org.el 66 (defvar org-odd-levels-only) ; defined in org.el 67 (defvar org-outline-regexp) ; defined in org.el 68 (defvar org-outline-regexp-bol) ; defined in org.el 69 70 71 ;;;; Constants 72 73 (defconst org-footnote-re 74 "\\[fn:\\(?:\\(?1:[-_[:word:]]+\\)?\\(:\\)\\|\\(?1:[-_[:word:]]+\\)\\]\\)" 75 "Regular expression for matching footnotes. 76 Match group 1 contains footnote's label. It is nil for anonymous 77 footnotes. Match group 2 is non-nil only when footnote is 78 inline, i.e., it contains its own definition.") 79 80 (defconst org-footnote-definition-re "^\\[fn:\\([-_[:word:]]+\\)\\]" 81 "Regular expression matching the definition of a footnote. 82 Match group 1 contains definition's label.") 83 84 (defconst org-footnote-forbidden-blocks '("comment" "example" "export" "src") 85 "Names of blocks where footnotes are not allowed.") 86 87 88 ;;;; Customization 89 90 (defgroup org-footnote nil 91 "Footnotes in Org mode." 92 :tag "Org Footnote" 93 :group 'org) 94 95 (defcustom org-footnote-section "Footnotes" 96 "Outline heading containing footnote definitions. 97 98 This can be nil, to place footnotes locally at the end of the current 99 outline node. It can also be a string representing the name of a 100 special outline heading under which footnotes should be put. 101 102 This variable defines the place where Org puts the definition 103 automatically, i.e. when creating the footnote, and when sorting 104 the notes. However, by hand, you may place definitions 105 *anywhere*. 106 107 If this is a string, during export, all subtrees starting with 108 this heading will be ignored. 109 110 If you don't use the customize interface to change this variable, 111 you will need to run the following command after the change: 112 113 `\\[universal-argument] \\[org-element-cache-reset]'" 114 :group 'org-footnote 115 :initialize 'custom-initialize-default 116 :set (lambda (var val) 117 (set-default-toplevel-value var val) 118 (when (fboundp 'org-element-cache-reset) 119 (org-element-cache-reset 'all))) 120 :type '(choice 121 (string :tag "Collect footnotes under heading") 122 (const :tag "Define footnotes locally" nil)) 123 :safe #'string-or-null-p) 124 125 (defcustom org-footnote-define-inline nil 126 "Non-nil means define footnotes inline, at reference location. 127 When nil, footnotes will be defined in a special section near 128 the end of the document. When t, the [fn:label:definition] notation 129 will be used to define the footnote at the reference position." 130 :group 'org-footnote 131 :type 'boolean 132 :safe #'booleanp) 133 134 (defcustom org-footnote-auto-label t 135 "Non-nil means define automatically new labels for footnotes. 136 Possible values are: 137 138 nil Prompt the user for each label. 139 t Create unique labels of the form [fn:1], [fn:2], etc. 140 anonymous Create anonymous footnotes 141 confirm Like t, but let the user edit the created value. 142 The label can be removed from the minibuffer to create 143 an anonymous footnote. 144 random Automatically generate a unique, random label." 145 :group 'org-footnote 146 :package-version '(Org . "9.7") 147 :type '(choice 148 (const :tag "Prompt for label" nil) 149 (const :tag "Create automatic [fn:N]" t) 150 (const :tag "Offer automatic [fn:N] for editing" confirm) 151 (const :tag "Create anonymous [fn::]" anonymous) 152 (const :tag "Create a random label" random)) 153 :safe #'symbolp) 154 155 (defcustom org-footnote-auto-adjust nil 156 "Non-nil means automatically adjust footnotes after insert/delete. 157 When this is t, after each insertion or deletion of a footnote, 158 simple fn:N footnotes will be renumbered, and all footnotes will be sorted. 159 If you want to have just sorting or just renumbering, set this variable 160 to `sort' or `renumber'. 161 162 The main values of this variable can be set with in-buffer options: 163 164 #+STARTUP: fnadjust 165 #+STARTUP: nofnadjust" 166 :group 'org-footnote 167 :type '(choice 168 (const :tag "No adjustment" nil) 169 (const :tag "Renumber" renumber) 170 (const :tag "Sort" sort) 171 (const :tag "Renumber and Sort" t)) 172 :safe #'symbolp) 173 174 (defcustom org-footnote-fill-after-inline-note-extraction nil 175 "Non-nil means fill paragraphs after extracting footnotes. 176 When extracting inline footnotes, the lengths of lines can change a lot. 177 When this option is set, paragraphs from which an inline footnote has been 178 extracted will be filled again." 179 :group 'org-footnote 180 :type 'boolean 181 :safe #'booleanp) 182 183 184 ;;;; Predicates 185 186 (defun org-footnote-in-valid-context-p () 187 "Is point in a context where footnotes are allowed?" 188 (save-match-data 189 (not (or (org-at-comment-p) 190 (org-inside-LaTeX-fragment-p) 191 ;; Avoid literal example. 192 (org-in-verbatim-emphasis) 193 (save-excursion 194 (forward-line 0) 195 (looking-at "[ \t]*:[ \t]+")) 196 ;; Avoid forbidden blocks. 197 (org-in-block-p org-footnote-forbidden-blocks))))) 198 199 (defun org-footnote-at-reference-p () 200 "Non-nil if point is at a footnote reference. 201 If so, return a list containing its label, beginning and ending 202 positions, and the definition, when inline." 203 (let ((reference (org-element-context))) 204 (when (org-element-type-p reference 'footnote-reference) 205 (let ((end (save-excursion 206 (goto-char (org-element-property :end reference)) 207 (skip-chars-backward " \t") 208 (point)))) 209 (when (< (point) end) 210 (list (org-element-property :label reference) 211 (org-element-property :begin reference) 212 end 213 (and (eq 'inline (org-element-property :type reference)) 214 (buffer-substring-no-properties 215 (org-element-property :contents-begin reference) 216 (org-element-property :contents-end 217 reference))))))))) 218 219 (defun org-footnote-at-definition-p () 220 "Non-nil if point is within a footnote definition. 221 222 This matches only pure definitions like [fn:name] at the 223 beginning of a line. It does not match references like 224 \[fn:name:definition], where the footnote text is included and 225 defined locally. 226 227 The return value is nil if not at a footnote definition, and 228 a list with label, start, end and definition of the footnote 229 otherwise." 230 (pcase (org-element-lineage (org-element-at-point) 'footnote-definition t) 231 (`nil nil) 232 (definition 233 (let* ((label (org-element-property :label definition)) 234 (begin (org-element-property :post-affiliated definition)) 235 (end (save-excursion 236 (goto-char (org-element-property :end definition)) 237 (skip-chars-backward " \r\t\n") 238 (line-beginning-position 2))) 239 (contents-begin (org-element-property :contents-begin definition)) 240 (contents-end (org-element-property :contents-end definition)) 241 (contents 242 (if (not contents-begin) "" 243 (org-trim 244 (buffer-substring-no-properties contents-begin 245 contents-end))))) 246 (list label begin end contents))))) 247 248 249 ;;;; Internal functions 250 251 (defun org-footnote--allow-reference-p () 252 "Non-nil when a footnote reference can be inserted at point." 253 ;; XXX: This is similar to `org-footnote-in-valid-context-p' but 254 ;; more accurate and usually faster, except in some corner cases. 255 ;; It may replace it after doing proper benchmarks as it would be 256 ;; used in fontification. 257 (unless (bolp) 258 (let* ((context (org-element-context)) 259 (type (org-element-type context))) 260 (cond 261 ;; No footnote reference in attributes. 262 ((let ((post (org-element-property :post-affiliated context))) 263 (and post (< (point) post))) 264 nil) 265 ;; Paragraphs and blank lines at top of document are fine. 266 ((memq type '(nil paragraph))) 267 ;; So are contents of verse blocks. 268 ((eq type 'verse-block) 269 (and (>= (point) (org-element-property :contents-begin context)) 270 (< (point) (org-element-property :contents-end context)))) 271 ;; In an headline or inlinetask, point must be either on the 272 ;; heading itself or on the blank lines below. 273 ((memq type '(headline inlinetask)) 274 (or (not (org-at-heading-p)) 275 (and (save-excursion 276 (forward-line 0) 277 (and (let ((case-fold-search t)) 278 (not (looking-at-p "\\*+ END[ \t]*$"))) 279 (let ((case-fold-search nil)) 280 (looking-at org-complex-heading-regexp)))) 281 (match-beginning 4) 282 (>= (point) (match-beginning 4)) 283 (or (not (match-beginning 5)) 284 (< (point) (match-beginning 5)))))) 285 ;; White spaces after an object or blank lines after an element 286 ;; are OK. 287 ((>= (point) 288 (save-excursion (goto-char (org-element-property :end context)) 289 (skip-chars-backward " \r\t\n") 290 (if (eq (org-element-class context) 'object) (point) 291 (line-beginning-position 2))))) 292 ;; At the beginning of a footnote definition, right after the 293 ;; label, is OK. 294 ((eq type 'footnote-definition) (looking-at (rx space))) 295 ;; Other elements are invalid. 296 ((eq (org-element-class context) 'element) nil) 297 ;; Just before object is fine. 298 ((= (point) (org-element-property :begin context))) 299 ;; Within recursive object too, but not in a link. 300 ((eq type 'link) nil) 301 ((eq type 'table-cell) 302 ;; :contents-begin is not reliable on empty cells, so special 303 ;; case it. 304 (<= (save-excursion (skip-chars-backward " \t") (point)) 305 (org-element-property :contents-end context))) 306 ((let ((cbeg (org-element-property :contents-begin context)) 307 (cend (org-element-property :contents-end context))) 308 (and cbeg (>= (point) cbeg) (<= (point) cend)))))))) 309 310 (defun org-footnote--clear-footnote-section () 311 "Remove all footnote sections in buffer and create a new one. 312 New section is created at the end of the buffer. Leave point 313 within the new section." 314 (when org-footnote-section 315 (goto-char (point-min)) 316 (let ((regexp (format "^\\*+ +%s[ \t]*$" 317 (regexp-quote org-footnote-section)))) 318 (while (re-search-forward regexp nil t) 319 (delete-region 320 (match-beginning 0) 321 (org-end-of-subtree t t)))) 322 (goto-char (point-max)) 323 ;; Clean-up blank lines at the end of the buffer. 324 (skip-chars-backward " \r\t\n") 325 (unless (bobp) 326 (forward-line) 327 (when (eolp) (insert "\n"))) 328 (delete-region (point) (point-max)) 329 (when (and (cdr (assq 'heading org-blank-before-new-entry)) 330 (zerop (save-excursion (org-back-over-empty-lines)))) 331 (insert "\n")) 332 (insert "* " org-footnote-section "\n"))) 333 334 (defun org-footnote--set-label (label) 335 "Set label of footnote at point to string LABEL. 336 Assume point is at the beginning of the reference or definition 337 to rename." 338 (forward-char 4) 339 (cond ((eq (char-after) ?:) (insert label)) 340 ((looking-at "\\([-_[:word:]]+\\)") (replace-match label nil nil nil 1)) 341 (t nil))) 342 343 (defun org-footnote--collect-references (&optional anonymous) 344 "Collect all labeled footnote references in current buffer. 345 346 Return an alist where associations follow the pattern 347 348 (LABEL MARKER TOP-LEVEL SIZE) 349 350 with 351 352 LABEL the label of the of the definition, 353 MARKER a marker pointing to its beginning, 354 TOP-LEVEL a boolean, nil when the footnote is contained within 355 another one, 356 SIZE the length of the inline definition, in characters, 357 or nil for non-inline references. 358 359 When optional ANONYMOUS is non-nil, also collect anonymous 360 references. In such cases, LABEL is nil. 361 362 References are sorted according to a deep-reading order." 363 (org-with-wide-buffer 364 (goto-char (point-min)) 365 (let ((regexp (if anonymous org-footnote-re "\\[fn:[-_[:word:]]+[]:]")) 366 references nested) 367 (save-excursion 368 (while (re-search-forward regexp nil t) 369 ;; Ignore definitions. 370 (unless (and (eq (char-before) ?\]) 371 (= (line-beginning-position) (match-beginning 0))) 372 ;; Ensure point is within the reference before parsing it. 373 (backward-char) 374 (let ((object (org-element-context))) 375 (when (org-element-type-p object 'footnote-reference) 376 (let* ((label (org-element-property :label object)) 377 (begin (org-element-property :begin object)) 378 (size 379 (and (eq (org-element-property :type object) 'inline) 380 (- (org-element-property :contents-end object) 381 (org-element-property :contents-begin object))))) 382 (let ((d (org-element-lineage object 'footnote-definition))) 383 (push (list label (copy-marker begin) (not d) size) 384 references) 385 (when d 386 ;; Nested references are stored in alist NESTED. 387 ;; Associations there follow the pattern 388 ;; 389 ;; (DEFINITION-LABEL . REFERENCES) 390 (let* ((def-label (org-element-property :label d)) 391 (labels (assoc def-label nested))) 392 (if labels (push label (cdr labels)) 393 (push (list def-label label) nested))))))))))) 394 ;; Sort the list of references. Nested footnotes have priority 395 ;; over top-level ones. 396 (letrec ((ordered nil) 397 (add-reference 398 (lambda (ref allow-nested) 399 (when (or allow-nested (nth 2 ref)) 400 (push ref ordered) 401 (dolist (r (mapcar (lambda (l) (assoc l references)) 402 (reverse 403 (cdr (assoc (nth 0 ref) nested))))) 404 (funcall add-reference r t)))))) 405 (dolist (r (reverse references) (nreverse ordered)) 406 (funcall add-reference r nil)))))) 407 408 (defun org-footnote--collect-definitions (&optional delete) 409 "Collect all footnote definitions in current buffer. 410 411 Return an alist where associations follow the pattern 412 413 (LABEL . DEFINITION) 414 415 with LABEL and DEFINITION being, respectively, the label and the 416 definition of the footnote, as strings. 417 418 When optional argument DELETE is non-nil, delete the definition 419 while collecting them." 420 (org-with-wide-buffer 421 (goto-char (point-min)) 422 (let (definitions seen) 423 (while (re-search-forward org-footnote-definition-re nil t) 424 (backward-char) 425 (let ((element (org-element-at-point))) 426 (let ((label (org-element-property :label element))) 427 (when (and (org-element-type-p element 'footnote-definition) 428 (not (member label seen))) 429 (push label seen) 430 (let* ((beg (progn 431 (goto-char (org-element-property :begin element)) 432 (skip-chars-backward " \r\t\n") 433 (if (bobp) (point) (line-beginning-position 2)))) 434 (end (progn 435 (goto-char (org-element-property :end element)) 436 (skip-chars-backward " \r\t\n") 437 (line-beginning-position 2))) 438 (def (org-trim (buffer-substring-no-properties beg end)))) 439 (push (cons label def) definitions) 440 (when delete (delete-region beg end))))))) 441 definitions))) 442 443 (defun org-footnote--goto-local-insertion-point () 444 "Find insertion point for footnote, just before next outline heading. 445 Assume insertion point is within currently accessible part of the buffer." 446 (org-with-limited-levels (outline-next-heading)) 447 (skip-chars-backward " \t\n") 448 (unless (bobp) (forward-line)) 449 (unless (bolp) (insert "\n"))) 450 451 452 ;;;; Navigation 453 454 (defun org-footnote-get-next-reference (&optional label backward limit) 455 "Return complete reference of the next footnote. 456 457 If LABEL is provided, get the next reference of that footnote. If 458 BACKWARD is non-nil, find previous reference instead. LIMIT is 459 the buffer position bounding the search. 460 461 Return value is a list like those provided by `org-footnote-at-reference-p'. 462 If no footnote is found, return nil." 463 (let ((label-regexp (if label (format "\\[fn:%s[]:]" label) org-footnote-re))) 464 (catch :exit 465 (save-excursion 466 (while (funcall (if backward #'re-search-backward #'re-search-forward) 467 label-regexp limit t) 468 (unless backward (backward-char)) 469 (pcase (org-footnote-at-reference-p) 470 (`nil nil) 471 (reference (throw :exit reference)))))))) 472 473 (defun org-footnote-next-reference-or-definition (limit) 474 "Move point to next footnote reference or definition. 475 476 LIMIT is the buffer position bounding the search. 477 478 Return value is a list like those provided by 479 `org-footnote-at-reference-p' or `org-footnote-at-definition-p'. 480 If no footnote is found, return nil. 481 482 This function is meant to be used for fontification only." 483 (let ((origin (point))) 484 (catch 'exit 485 (while t 486 (unless (re-search-forward org-footnote-re limit t) 487 (goto-char origin) 488 (throw 'exit nil)) 489 ;; Beware: with non-inline footnotes point will be just after 490 ;; the closing square bracket. 491 (backward-char) 492 (cond 493 ((and (/= (match-beginning 0) (line-beginning-position)) 494 (let* ((beg (match-beginning 0)) 495 (label (match-string-no-properties 1)) 496 ;; Inline footnotes don't end at (match-end 0) 497 ;; as `org-footnote-re' stops just after the 498 ;; second colon. Find the real ending with 499 ;; `scan-sexps', so Org doesn't get fooled by 500 ;; unrelated closing square brackets. 501 (end (ignore-errors (scan-sexps beg 1)))) 502 (and end 503 ;; Verify match isn't a part of a link. 504 (not (save-excursion 505 (goto-char beg) 506 (let ((linkp 507 (save-match-data 508 (org-in-regexp org-link-bracket-re)))) 509 (and linkp (< (point) (cdr linkp)))))) 510 ;; Verify point doesn't belong to a LaTeX macro. 511 (not (org-inside-latex-macro-p)) 512 (throw 'exit 513 (list label beg end 514 ;; Definition: ensure this is an 515 ;; inline footnote first. 516 (and (match-end 2) 517 (org-trim 518 (buffer-substring-no-properties 519 (match-end 0) (1- end)))))))))) 520 ;; Definition: also grab the last square bracket, matched in 521 ;; `org-footnote-re' for non-inline footnotes. 522 ((and (save-excursion 523 (forward-line 0) 524 (save-match-data (org-footnote-in-valid-context-p))) 525 (save-excursion 526 (end-of-line) 527 ;; Footnotes definitions are separated by new 528 ;; headlines, another footnote definition or 2 blank 529 ;; lines. 530 (let ((end (match-end 0)) 531 (lim (save-excursion 532 (re-search-backward 533 (concat org-outline-regexp-bol 534 "\\|^\\([ \t]*\n\\)\\{2,\\}") 535 nil t)))) 536 (and (re-search-backward org-footnote-definition-re lim t) 537 (throw 'exit 538 (list nil 539 (match-beginning 0) 540 (if (eq (char-before end) ?\]) end 541 (1+ end))))))))) 542 (t nil)))))) 543 544 (defun org-footnote-goto-definition (label &optional location) 545 "Move point to the definition of the footnote LABEL. 546 547 LOCATION, when non-nil specifies the buffer position of the 548 definition. 549 550 Throw an error if there is no definition or if it cannot be 551 reached from current narrowed part of buffer. Return a non-nil 552 value if point was successfully moved." 553 (interactive "sLabel: ") 554 (let* ((label (org-footnote-normalize-label label)) 555 (def-start (or location (nth 1 (org-footnote-get-definition label))))) 556 (cond 557 ((not def-start) 558 (user-error "Cannot find definition of footnote %s" label)) 559 ((or (> def-start (point-max)) (< def-start (point-min))) 560 (user-error "Definition is outside narrowed part of buffer"))) 561 (org-mark-ring-push) 562 (goto-char def-start) 563 (looking-at (format "\\[fn:%s[]:]" (regexp-quote label))) 564 (goto-char (match-end 0)) 565 (org-fold-show-context 'link-search) 566 (when (derived-mode-p 'org-mode) 567 (message "%s" (substitute-command-keys 568 "Edit definition and go back with \ 569 `\\[org-mark-ring-goto]' or, if unique, with `\\[org-ctrl-c-ctrl-c]'."))) 570 t)) 571 572 (defun org-footnote-goto-previous-reference (label) 573 "Find the first closest (to point) reference of footnote with label LABEL." 574 (interactive "sLabel: ") 575 (let* ((label (org-footnote-normalize-label label)) 576 (reference 577 (save-excursion 578 (or (org-footnote-get-next-reference label t) 579 (org-footnote-get-next-reference label) 580 (and (buffer-narrowed-p) 581 (org-with-wide-buffer 582 (or (org-footnote-get-next-reference label t) 583 (org-footnote-get-next-reference label))))))) 584 (start (nth 1 reference))) 585 (cond ((not reference) 586 (user-error "Cannot find reference of footnote %S" label)) 587 ((or (> start (point-max)) (< start (point-min))) 588 (user-error "Reference is outside narrowed part of buffer"))) 589 (org-mark-ring-push) 590 (goto-char start) 591 (org-fold-show-context 'link-search))) 592 593 594 ;;;; Getters 595 596 (defun org-footnote-normalize-label (label) 597 "Return LABEL without \"fn:\" prefix. 598 If LABEL is the empty string or constituted of white spaces only, 599 return nil instead." 600 (pcase (org-trim label) 601 ("" nil) 602 ((pred (string-prefix-p "fn:")) (substring label 3)) 603 (_ label))) 604 605 (defun org-footnote-get-definition (label) 606 "Return label, boundaries and definition of the footnote LABEL." 607 (let* ((label (regexp-quote (org-footnote-normalize-label label))) 608 (re (format "^\\[fn:%s\\]\\|.\\[fn:%s:" label label))) 609 (org-with-wide-buffer 610 (goto-char (point-min)) 611 (catch 'found 612 (while (re-search-forward re nil t) 613 (let* ((datum (progn (backward-char) (org-element-context))) 614 (type (org-element-type datum))) 615 (when (memq type '(footnote-definition footnote-reference)) 616 (throw 'found 617 (list 618 label 619 (org-element-property :begin datum) 620 (org-element-property :end datum) 621 (let ((cbeg (org-element-property :contents-begin datum))) 622 (if (not cbeg) "" 623 (replace-regexp-in-string 624 "[ \t\n]*\\'" 625 "" 626 (buffer-substring-no-properties 627 cbeg 628 (org-element-property :contents-end datum)))))))))) 629 nil)))) 630 631 (defun org-footnote-all-labels () 632 "List all defined footnote labels used throughout the buffer. 633 This function ignores narrowing, if any." 634 (org-with-wide-buffer 635 (goto-char (point-min)) 636 (let (all) 637 (while (re-search-forward org-footnote-re nil t) 638 (backward-char) 639 (let ((context (org-element-context))) 640 (when (org-element-type-p 641 context '(footnote-definition footnote-reference)) 642 (let ((label (org-element-property :label context))) 643 (when label (cl-pushnew label all :test #'equal)))))) 644 all))) 645 646 (defun org-footnote-unique-label (&optional current) 647 "Return a new unique footnote label. 648 649 The function returns the first numeric label currently unused. 650 651 Optional argument CURRENT is the list of labels active in the 652 buffer." 653 (let ((current (or current (org-footnote-all-labels)))) 654 (let ((count 1)) 655 (while (member (number-to-string count) current) 656 (cl-incf count)) 657 (number-to-string count)))) 658 659 660 ;;;; Adding, Deleting Footnotes 661 662 (defun org-footnote-new () 663 "Insert a new footnote. 664 This command prompts for a label. If this is a label referencing an 665 existing label, only insert the label. If the footnote label is empty 666 or new, let the user edit the definition of the footnote." 667 (interactive) 668 (unless (org-footnote--allow-reference-p) 669 (user-error "Cannot insert a footnote here")) 670 (let* ((all (org-footnote-all-labels)) 671 (label 672 (unless (eq org-footnote-auto-label 'anonymous) 673 (if (eq org-footnote-auto-label 'random) 674 (format "%x" (abs (random))) 675 (org-footnote-normalize-label 676 (let ((propose (org-footnote-unique-label all))) 677 (if (eq org-footnote-auto-label t) propose 678 (completing-read 679 "Label (leave empty for anonymous): " 680 (mapcar #'list all) nil nil 681 (and (eq org-footnote-auto-label 'confirm) propose))))))))) 682 (cond ((not label) 683 (insert "[fn::]") 684 (backward-char 1)) 685 ((member label all) 686 (insert "[fn:" label "]") 687 (message "New reference to existing note")) 688 (org-footnote-define-inline 689 (insert "[fn:" label ":]") 690 (backward-char 1) 691 (org-footnote-auto-adjust-maybe)) 692 (t 693 (insert "[fn:" label "]") 694 (let ((p (org-footnote-create-definition label))) 695 ;; `org-footnote-goto-definition' needs to be called 696 ;; after `org-footnote-auto-adjust-maybe'. Otherwise 697 ;; both label and location of the definition are lost. 698 ;; On the contrary, it needs to be called before 699 ;; `org-edit-footnote-reference' so that the remote 700 ;; editing buffer can display the correct label. 701 (if (ignore-errors (org-footnote-goto-definition label p)) 702 (org-footnote-auto-adjust-maybe) 703 ;; Definition was created outside current scope: edit 704 ;; it remotely. 705 (org-footnote-auto-adjust-maybe) 706 (org-edit-footnote-reference))))))) 707 708 (defun org-footnote-create-definition (label) 709 "Start the definition of a footnote with label LABEL. 710 Return buffer position at the beginning of the definition. This 711 function doesn't move point." 712 (let ((label (org-footnote-normalize-label label)) 713 electric-indent-mode) ; Prevent wrong indentation. 714 (org-preserve-local-variables 715 (org-with-wide-buffer 716 (cond 717 ((not org-footnote-section) (org-footnote--goto-local-insertion-point)) 718 ((save-excursion 719 (goto-char (point-min)) 720 (re-search-forward 721 (concat "^\\*+[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$") 722 nil t)) 723 (goto-char (match-end 0)) 724 (org-end-of-meta-data t) 725 (unless (bolp) (insert "\n"))) 726 (t (org-footnote--clear-footnote-section))) 727 (when (zerop (org-back-over-empty-lines)) (insert "\n")) 728 (insert "[fn:" label "] \n") 729 (line-beginning-position 0))))) 730 731 (defun org-footnote-delete-references (label) 732 "Delete every reference to footnote LABEL. 733 Return the number of footnotes removed." 734 (save-excursion 735 (goto-char (point-min)) 736 (let (ref (nref 0)) 737 (while (setq ref (org-footnote-get-next-reference label)) 738 (goto-char (nth 1 ref)) 739 (delete-region (nth 1 ref) (nth 2 ref)) 740 (cl-incf nref)) 741 nref))) 742 743 (defun org-footnote-delete-definitions (label) 744 "Delete every definition of the footnote LABEL. 745 Return the number of footnotes removed." 746 (save-excursion 747 (goto-char (point-min)) 748 (let ((def-re (format "^\\[fn:%s\\]" (regexp-quote label))) 749 (ndef 0)) 750 (while (re-search-forward def-re nil t) 751 (pcase (org-footnote-at-definition-p) 752 (`(,_ ,start ,end ,_) 753 ;; Remove the footnote, and all blank lines before it. 754 (delete-region (progn 755 (goto-char start) 756 (skip-chars-backward " \r\t\n") 757 (if (bobp) (point) (line-beginning-position 2))) 758 (progn 759 (goto-char end) 760 (skip-chars-backward " \r\t\n") 761 (if (bobp) (point) (line-beginning-position 2)))) 762 (cl-incf ndef)))) 763 ndef))) 764 765 (defun org-footnote-delete (&optional label) 766 "Delete the footnote at point. 767 This will remove the definition (even multiple definitions if they exist) 768 and all references of a footnote label. 769 770 If LABEL is non-nil, delete that footnote instead." 771 (catch 'done 772 (org-preserve-local-variables 773 (let* ((nref 0) (ndef 0) x 774 ;; 1. Determine LABEL of footnote at point. 775 (label (cond 776 ;; LABEL is provided as argument. 777 (label) 778 ;; Footnote reference at point. If the footnote is 779 ;; anonymous, delete it and exit instead. 780 ((setq x (org-footnote-at-reference-p)) 781 (or (car x) 782 (progn 783 (delete-region (nth 1 x) (nth 2 x)) 784 (message "Anonymous footnote removed") 785 (throw 'done t)))) 786 ;; Footnote definition at point. 787 ((setq x (org-footnote-at-definition-p)) 788 (car x)) 789 (t (error "Don't know which footnote to remove"))))) 790 ;; 2. Now that LABEL is non-nil, find every reference and every 791 ;; definition, and delete them. 792 (setq nref (org-footnote-delete-references label) 793 ndef (org-footnote-delete-definitions label)) 794 ;; 3. Verify consistency of footnotes and notify user. 795 (org-footnote-auto-adjust-maybe) 796 (message "%d definition(s) of and %d reference(s) of footnote %s removed" 797 ndef nref label))))) 798 799 800 ;;;; Sorting, Renumbering, Normalizing 801 802 (defun org-footnote-renumber-fn:N () 803 "Order numbered footnotes into a sequence in the document." 804 (interactive) 805 (let* ((c 0) 806 (references (cl-remove-if-not 807 (lambda (r) (string-match-p "\\`[0-9]+\\'" (car r))) 808 (org-footnote--collect-references))) 809 (alist (mapcar (lambda (l) (cons l (number-to-string (cl-incf c)))) 810 (delete-dups (mapcar #'car references))))) 811 (org-with-wide-buffer 812 ;; Re-number references. 813 (dolist (ref references) 814 (goto-char (nth 1 ref)) 815 (org-footnote--set-label (cdr (assoc (nth 0 ref) alist)))) 816 ;; Re-number definitions. 817 (goto-char (point-min)) 818 (while (re-search-forward "^\\[fn:\\([0-9]+\\)\\]" nil t) 819 (replace-match (or (cdr (assoc (match-string 1) alist)) 820 ;; Un-referenced definitions get higher 821 ;; numbers. 822 (number-to-string (cl-incf c))) 823 nil nil nil 1))))) 824 825 (defun org-footnote-sort () 826 "Rearrange footnote definitions in the current buffer. 827 Sort footnote definitions so they match order of footnote 828 references. Also relocate definitions at the end of their 829 relative section or within a single footnote section, according 830 to `org-footnote-section'. Inline definitions are ignored." 831 (let ((references (org-footnote--collect-references))) 832 (org-preserve-local-variables 833 (let ((definitions (org-footnote--collect-definitions 'delete))) 834 (org-with-wide-buffer 835 (org-footnote--clear-footnote-section) 836 ;; Insert footnote definitions at the appropriate location, 837 ;; separated by a blank line. Each definition is inserted 838 ;; only once throughout the buffer. 839 (let (inserted) 840 (dolist (cell references) 841 (let ((label (car cell)) 842 (nested (not (nth 2 cell))) 843 (inline (nth 3 cell))) 844 (unless (or (member label inserted) inline) 845 (push label inserted) 846 (unless (or org-footnote-section nested) 847 ;; If `org-footnote-section' is non-nil, or 848 ;; reference is nested, point is already at the 849 ;; correct position. Otherwise, move at the 850 ;; appropriate location within the section 851 ;; containing the reference. 852 (goto-char (nth 1 cell)) 853 (org-footnote--goto-local-insertion-point)) 854 (insert "\n" 855 (or (cdr (assoc label definitions)) 856 (format "[fn:%s] DEFINITION NOT FOUND." label)) 857 "\n")))) 858 ;; Insert un-referenced footnote definitions at the end. 859 ;; Combine all insertions into one to create a single cache 860 ;; update call. 861 (org-combine-change-calls (point) (point) 862 (pcase-dolist (`(,label . ,definition) definitions) 863 (unless (member label inserted) 864 (insert "\n" definition "\n")))))))))) 865 866 (defun org-footnote-normalize () 867 "Turn every footnote in buffer into a numbered one." 868 (interactive) 869 (org-preserve-local-variables 870 (let ((n 0) 871 (translations nil) 872 (definitions nil) 873 (references (org-footnote--collect-references 'anonymous))) 874 (org-with-wide-buffer 875 ;; Update label for reference. We need to do this before 876 ;; clearing definitions in order to rename nested footnotes 877 ;; before they are deleted. 878 (dolist (cell references) 879 (let* ((label (car cell)) 880 (anonymous (not label)) 881 (new 882 (cond 883 ;; In order to differentiate anonymous references 884 ;; from regular ones, set their labels to integers, 885 ;; not strings. 886 (anonymous (setcar cell (cl-incf n))) 887 ((cdr (assoc label translations))) 888 (t (let ((l (number-to-string (cl-incf n)))) 889 (push (cons label l) translations) 890 l))))) 891 (goto-char (nth 1 cell)) ; Move to reference's start. 892 (org-footnote--set-label 893 (if anonymous (number-to-string new) new)) 894 (let ((size (nth 3 cell))) 895 ;; Transform inline footnotes into regular references and 896 ;; retain their definition for later insertion as 897 ;; a regular footnote definition. 898 (when size 899 (let ((def (concat 900 (format "[fn:%s] " new) 901 (org-trim 902 (substring 903 (delete-and-extract-region 904 (point) (+ (point) size 1)) 905 1))))) 906 (push (cons (if anonymous new label) def) definitions) 907 (when org-footnote-fill-after-inline-note-extraction 908 (org-fill-paragraph))))))) 909 ;; Collect definitions. Update labels according to ALIST. 910 (let ((definitions 911 (nconc definitions 912 (org-footnote--collect-definitions 'delete))) 913 (inserted)) 914 (org-footnote--clear-footnote-section) 915 (dolist (cell references) 916 (let* ((label (car cell)) 917 (anonymous (integerp label)) 918 (pos (nth 1 cell))) 919 ;; Move to appropriate location, if required. When there 920 ;; is a footnote section or reference is nested, point is 921 ;; already at the expected location. 922 (unless (or org-footnote-section (not (nth 2 cell))) 923 (goto-char pos) 924 (org-footnote--goto-local-insertion-point)) 925 ;; Insert new definition once label is updated. 926 (unless (member label inserted) 927 (push label inserted) 928 (let ((stored (cdr (assoc label definitions))) 929 ;; Anonymous footnotes' label is already 930 ;; up-to-date. 931 (new (if anonymous label 932 (cdr (assoc label translations))))) 933 (insert "\n" 934 (cond 935 ((not stored) 936 (format "[fn:%s] DEFINITION NOT FOUND." new)) 937 (anonymous stored) 938 (t 939 (replace-regexp-in-string 940 "\\`\\[fn:\\(.*?\\)\\]" new stored nil nil 1))) 941 "\n"))))) 942 ;; Insert un-referenced footnote definitions at the end. 943 (pcase-dolist (`(,label . ,definition) definitions) 944 (unless (member label inserted) 945 (insert "\n" 946 (replace-regexp-in-string org-footnote-definition-re 947 (format "[fn:%d]" (cl-incf n)) 948 definition) 949 "\n")))))))) 950 951 (defun org-footnote-auto-adjust-maybe () 952 "Renumber and/or sort footnotes according to user settings." 953 (when (memq org-footnote-auto-adjust '(t renumber)) 954 (org-footnote-renumber-fn:N)) 955 (when (memq org-footnote-auto-adjust '(t sort)) 956 (let ((label (car (org-footnote-at-definition-p)))) 957 (org-footnote-sort) 958 (when label 959 (goto-char (point-min)) 960 (and (re-search-forward (format "^\\[fn:%s\\]" (regexp-quote label)) 961 nil t) 962 (progn (insert " ") 963 (just-one-space))))))) 964 965 966 ;;;; End-user interface 967 968 ;;;###autoload 969 (defun org-footnote-action (&optional special) 970 "Do the right thing for footnotes. 971 972 When at a footnote reference, jump to the definition. 973 974 When at a definition, jump to the references if they exist, offer 975 to create them otherwise. 976 977 When neither at definition or reference, create a new footnote, 978 interactively if possible. 979 980 With prefix arg SPECIAL, or when no footnote can be created, 981 offer additional commands in a menu." 982 (interactive "P") 983 (let* ((context (and (not special) (org-element-context))) 984 (type (org-element-type context))) 985 (cond 986 ;; On white space after element, insert a new footnote. 987 ((and context 988 (> (point) 989 (save-excursion 990 (goto-char (org-element-property :end context)) 991 (skip-chars-backward " \t") 992 (point)))) 993 (org-footnote-new)) 994 ((eq type 'footnote-reference) 995 (let ((label (org-element-property :label context))) 996 (cond 997 ;; Anonymous footnote: move point at the beginning of its 998 ;; definition. 999 ((not label) 1000 (goto-char (org-element-property :contents-begin context))) 1001 ;; Check if a definition exists: then move to it. 1002 ((let ((p (nth 1 (org-footnote-get-definition label)))) 1003 (when p (org-footnote-goto-definition label p)))) 1004 ;; No definition exists: offer to create it. 1005 ((yes-or-no-p (format "No definition for %s. Create one? " label)) 1006 (let ((p (org-footnote-create-definition label))) 1007 (or (ignore-errors (org-footnote-goto-definition label p)) 1008 ;; Since definition was created outside current scope, 1009 ;; edit it remotely. 1010 (org-edit-footnote-reference))))))) 1011 ((eq type 'footnote-definition) 1012 (org-footnote-goto-previous-reference 1013 (org-element-property :label context))) 1014 ((or special (not (org-footnote--allow-reference-p))) 1015 (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s | [n]ormalize | \ 1016 \[d]elete") 1017 (pcase (read-char-exclusive) 1018 (?s (org-footnote-sort)) 1019 (?r (org-footnote-renumber-fn:N)) 1020 (?S (org-footnote-renumber-fn:N) 1021 (org-footnote-sort)) 1022 (?n (org-footnote-normalize)) 1023 (?d (org-footnote-delete)) 1024 (char (error "No such footnote command %c" char)))) 1025 (t (org-footnote-new))))) 1026 1027 1028 (provide 'org-footnote) 1029 1030 ;; Local variables: 1031 ;; generated-autoload-file: "org-loaddefs.el" 1032 ;; End: 1033 1034 ;;; org-footnote.el ends here