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