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