mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-11-25 07:27:57 +00:00
1031 lines
37 KiB
EmacsLisp
1031 lines
37 KiB
EmacsLisp
;;; org-footnote.el --- Footnote support in Org -*- lexical-binding: t; -*-
|
||
;;
|
||
;; Copyright (C) 2009-2023 Free Software Foundation, Inc.
|
||
;;
|
||
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
|
||
;; Keywords: outlines, hypermedia, calendar, wp
|
||
;; URL: https://orgmode.org
|
||
;;
|
||
;; This file is part of GNU Emacs.
|
||
;;
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;
|
||
;;; Commentary:
|
||
|
||
;; This file contains the code dealing with footnotes in Org mode.
|
||
|
||
;;; Code:
|
||
|
||
(require 'org-macs)
|
||
(org-assert-version)
|
||
|
||
;;;; Declarations
|
||
|
||
(require 'cl-lib)
|
||
(require 'org-macs)
|
||
(require 'org-compat)
|
||
|
||
(declare-function org-at-comment-p "org" ())
|
||
(declare-function org-at-heading-p "org" (&optional ignored))
|
||
(declare-function org-back-over-empty-lines "org" ())
|
||
(declare-function org-end-of-meta-data "org" (&optional full))
|
||
(declare-function org-edit-footnote-reference "org-src" ())
|
||
(declare-function org-element-at-point "org-element" (&optional pom cached-only))
|
||
(declare-function org-element-class "org-element" (datum &optional parent))
|
||
(declare-function org-element-context "org-element" (&optional element))
|
||
(declare-function org-element-lineage "org-element-ast" (blob &optional types with-self))
|
||
(declare-function org-element-property "org-element-ast" (property node))
|
||
(declare-function org-element-type "org-element-ast" (node &optional anonymous))
|
||
(declare-function org-element-type-p "org-element-ast" (node types))
|
||
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
|
||
(declare-function org-fill-paragraph "org" (&optional justify region))
|
||
(declare-function org-in-block-p "org" (names))
|
||
(declare-function org-in-verbatim-emphasis "org" ())
|
||
(declare-function org-inside-LaTeX-fragment-p "org" ())
|
||
(declare-function org-inside-latex-macro-p "org" ())
|
||
(declare-function org-mark-ring-push "org" (&optional pos buffer))
|
||
(declare-function org-fold-show-context "org-fold" (&optional key))
|
||
(declare-function outline-next-heading "outline")
|
||
|
||
(defvar electric-indent-mode)
|
||
(defvar org-blank-before-new-entry) ; defined in org.el
|
||
(defvar org-link-bracket-re) ; defined in org.el
|
||
(defvar org-complex-heading-regexp) ; defined in org.el
|
||
(defvar org-odd-levels-only) ; defined in org.el
|
||
(defvar org-outline-regexp) ; defined in org.el
|
||
(defvar org-outline-regexp-bol) ; defined in org.el
|
||
|
||
|
||
;;;; Constants
|
||
|
||
(defconst org-footnote-re
|
||
"\\[fn:\\(?:\\(?1:[-_[:word:]]+\\)?\\(:\\)\\|\\(?1:[-_[:word:]]+\\)\\]\\)"
|
||
"Regular expression for matching footnotes.
|
||
Match group 1 contains footnote's label. It is nil for anonymous
|
||
footnotes. Match group 2 is non-nil only when footnote is
|
||
inline, i.e., it contains its own definition.")
|
||
|
||
(defconst org-footnote-definition-re "^\\[fn:\\([-_[:word:]]+\\)\\]"
|
||
"Regular expression matching the definition of a footnote.
|
||
Match group 1 contains definition's label.")
|
||
|
||
(defconst org-footnote-forbidden-blocks '("comment" "example" "export" "src")
|
||
"Names of blocks where footnotes are not allowed.")
|
||
|
||
|
||
;;;; Customization
|
||
|
||
(defgroup org-footnote nil
|
||
"Footnotes in Org mode."
|
||
:tag "Org Footnote"
|
||
:group 'org)
|
||
|
||
(defcustom org-footnote-section "Footnotes"
|
||
"Outline heading containing footnote definitions.
|
||
|
||
This can be nil, to place footnotes locally at the end of the current
|
||
outline node. It can also be a string representing the name of a
|
||
special outline heading under which footnotes should be put.
|
||
|
||
This variable defines the place where Org puts the definition
|
||
automatically, i.e. when creating the footnote, and when sorting
|
||
the notes. However, by hand, you may place definitions
|
||
*anywhere*.
|
||
|
||
If this is a string, during export, all subtrees starting with
|
||
this heading will be ignored.
|
||
|
||
If you don't use the customize interface to change this variable,
|
||
you will need to run the following command after the change:
|
||
|
||
`\\[universal-argument] \\[org-element-cache-reset]'"
|
||
:group 'org-footnote
|
||
:initialize 'custom-initialize-default
|
||
:set (lambda (var val)
|
||
(set-default-toplevel-value var val)
|
||
(when (fboundp 'org-element-cache-reset)
|
||
(org-element-cache-reset 'all)))
|
||
:type '(choice
|
||
(string :tag "Collect footnotes under heading")
|
||
(const :tag "Define footnotes locally" nil))
|
||
:safe #'string-or-null-p)
|
||
|
||
(defcustom org-footnote-define-inline nil
|
||
"Non-nil means define footnotes inline, at reference location.
|
||
When nil, footnotes will be defined in a special section near
|
||
the end of the document. When t, the [fn:label:definition] notation
|
||
will be used to define the footnote at the reference position."
|
||
:group 'org-footnote
|
||
:type 'boolean
|
||
:safe #'booleanp)
|
||
|
||
(defcustom org-footnote-auto-label t
|
||
"Non-nil means define automatically new labels for footnotes.
|
||
Possible values are:
|
||
|
||
nil Prompt the user for each label.
|
||
t Create unique labels of the form [fn:1], [fn:2], etc.
|
||
confirm Like t, but let the user edit the created value.
|
||
The label can be removed from the minibuffer to create
|
||
an anonymous footnote.
|
||
random Automatically generate a unique, random label."
|
||
:group 'org-footnote
|
||
:type '(choice
|
||
(const :tag "Prompt for label" nil)
|
||
(const :tag "Create automatic [fn:N]" t)
|
||
(const :tag "Offer automatic [fn:N] for editing" confirm)
|
||
(const :tag "Create a random label" random))
|
||
:safe #'symbolp)
|
||
|
||
(defcustom org-footnote-auto-adjust nil
|
||
"Non-nil means automatically adjust footnotes after insert/delete.
|
||
When this is t, after each insertion or deletion of a footnote,
|
||
simple fn:N footnotes will be renumbered, and all footnotes will be sorted.
|
||
If you want to have just sorting or just renumbering, set this variable
|
||
to `sort' or `renumber'.
|
||
|
||
The main values of this variable can be set with in-buffer options:
|
||
|
||
#+STARTUP: fnadjust
|
||
#+STARTUP: nofnadjust"
|
||
:group 'org-footnote
|
||
:type '(choice
|
||
(const :tag "No adjustment" nil)
|
||
(const :tag "Renumber" renumber)
|
||
(const :tag "Sort" sort)
|
||
(const :tag "Renumber and Sort" t))
|
||
:safe #'symbolp)
|
||
|
||
(defcustom org-footnote-fill-after-inline-note-extraction nil
|
||
"Non-nil means fill paragraphs after extracting footnotes.
|
||
When extracting inline footnotes, the lengths of lines can change a lot.
|
||
When this option is set, paragraphs from which an inline footnote has been
|
||
extracted will be filled again."
|
||
:group 'org-footnote
|
||
:type 'boolean
|
||
:safe #'booleanp)
|
||
|
||
|
||
;;;; Predicates
|
||
|
||
(defun org-footnote-in-valid-context-p ()
|
||
"Is point in a context where footnotes are allowed?"
|
||
(save-match-data
|
||
(not (or (org-at-comment-p)
|
||
(org-inside-LaTeX-fragment-p)
|
||
;; Avoid literal example.
|
||
(org-in-verbatim-emphasis)
|
||
(save-excursion
|
||
(forward-line 0)
|
||
(looking-at "[ \t]*:[ \t]+"))
|
||
;; Avoid forbidden blocks.
|
||
(org-in-block-p org-footnote-forbidden-blocks)))))
|
||
|
||
(defun org-footnote-at-reference-p ()
|
||
"Non-nil if point is at a footnote reference.
|
||
If so, return a list containing its label, beginning and ending
|
||
positions, and the definition, when inline."
|
||
(let ((reference (org-element-context)))
|
||
(when (org-element-type-p reference 'footnote-reference)
|
||
(let ((end (save-excursion
|
||
(goto-char (org-element-property :end reference))
|
||
(skip-chars-backward " \t")
|
||
(point))))
|
||
(when (< (point) end)
|
||
(list (org-element-property :label reference)
|
||
(org-element-property :begin reference)
|
||
end
|
||
(and (eq 'inline (org-element-property :type reference))
|
||
(buffer-substring-no-properties
|
||
(org-element-property :contents-begin reference)
|
||
(org-element-property :contents-end
|
||
reference)))))))))
|
||
|
||
(defun org-footnote-at-definition-p ()
|
||
"Non-nil if point is within a footnote definition.
|
||
|
||
This matches only pure definitions like [fn:name] at the
|
||
beginning of a line. It does not match references like
|
||
\[fn:name:definition], where the footnote text is included and
|
||
defined locally.
|
||
|
||
The return value is nil if not at a footnote definition, and
|
||
a list with label, start, end and definition of the footnote
|
||
otherwise."
|
||
(pcase (org-element-lineage (org-element-at-point) 'footnote-definition t)
|
||
(`nil nil)
|
||
(definition
|
||
(let* ((label (org-element-property :label definition))
|
||
(begin (org-element-property :post-affiliated definition))
|
||
(end (save-excursion
|
||
(goto-char (org-element-property :end definition))
|
||
(skip-chars-backward " \r\t\n")
|
||
(line-beginning-position 2)))
|
||
(contents-begin (org-element-property :contents-begin definition))
|
||
(contents-end (org-element-property :contents-end definition))
|
||
(contents
|
||
(if (not contents-begin) ""
|
||
(org-trim
|
||
(buffer-substring-no-properties contents-begin
|
||
contents-end)))))
|
||
(list label begin end contents)))))
|
||
|
||
|
||
;;;; Internal functions
|
||
|
||
(defun org-footnote--allow-reference-p ()
|
||
"Non-nil when a footnote reference can be inserted at point."
|
||
;; XXX: This is similar to `org-footnote-in-valid-context-p' but
|
||
;; more accurate and usually faster, except in some corner cases.
|
||
;; It may replace it after doing proper benchmarks as it would be
|
||
;; used in fontification.
|
||
(unless (bolp)
|
||
(let* ((context (org-element-context))
|
||
(type (org-element-type context)))
|
||
(cond
|
||
;; No footnote reference in attributes.
|
||
((let ((post (org-element-property :post-affiliated context)))
|
||
(and post (< (point) post)))
|
||
nil)
|
||
;; Paragraphs and blank lines at top of document are fine.
|
||
((memq type '(nil paragraph)))
|
||
;; So are contents of verse blocks.
|
||
((eq type 'verse-block)
|
||
(and (>= (point) (org-element-property :contents-begin context))
|
||
(< (point) (org-element-property :contents-end context))))
|
||
;; In an headline or inlinetask, point must be either on the
|
||
;; heading itself or on the blank lines below.
|
||
((memq type '(headline inlinetask))
|
||
(or (not (org-at-heading-p))
|
||
(and (save-excursion
|
||
(forward-line 0)
|
||
(and (let ((case-fold-search t))
|
||
(not (looking-at-p "\\*+ END[ \t]*$")))
|
||
(let ((case-fold-search nil))
|
||
(looking-at org-complex-heading-regexp))))
|
||
(match-beginning 4)
|
||
(>= (point) (match-beginning 4))
|
||
(or (not (match-beginning 5))
|
||
(< (point) (match-beginning 5))))))
|
||
;; White spaces after an object or blank lines after an element
|
||
;; are OK.
|
||
((>= (point)
|
||
(save-excursion (goto-char (org-element-property :end context))
|
||
(skip-chars-backward " \r\t\n")
|
||
(if (eq (org-element-class context) 'object) (point)
|
||
(line-beginning-position 2)))))
|
||
;; At the beginning of a footnote definition, right after the
|
||
;; label, is OK.
|
||
((eq type 'footnote-definition) (looking-at (rx space)))
|
||
;; Other elements are invalid.
|
||
((eq (org-element-class context) 'element) nil)
|
||
;; Just before object is fine.
|
||
((= (point) (org-element-property :begin context)))
|
||
;; Within recursive object too, but not in a link.
|
||
((eq type 'link) nil)
|
||
((eq type 'table-cell)
|
||
;; :contents-begin is not reliable on empty cells, so special
|
||
;; case it.
|
||
(<= (save-excursion (skip-chars-backward " \t") (point))
|
||
(org-element-property :contents-end context)))
|
||
((let ((cbeg (org-element-property :contents-begin context))
|
||
(cend (org-element-property :contents-end context)))
|
||
(and cbeg (>= (point) cbeg) (<= (point) cend))))))))
|
||
|
||
(defun org-footnote--clear-footnote-section ()
|
||
"Remove all footnote sections in buffer and create a new one.
|
||
New section is created at the end of the buffer. Leave point
|
||
within the new section."
|
||
(when org-footnote-section
|
||
(goto-char (point-min))
|
||
(let ((regexp (format "^\\*+ +%s[ \t]*$"
|
||
(regexp-quote org-footnote-section))))
|
||
(while (re-search-forward regexp nil t)
|
||
(delete-region
|
||
(match-beginning 0)
|
||
(org-end-of-subtree t t))))
|
||
(goto-char (point-max))
|
||
;; Clean-up blank lines at the end of the buffer.
|
||
(skip-chars-backward " \r\t\n")
|
||
(unless (bobp)
|
||
(forward-line)
|
||
(when (eolp) (insert "\n")))
|
||
(delete-region (point) (point-max))
|
||
(when (and (cdr (assq 'heading org-blank-before-new-entry))
|
||
(zerop (save-excursion (org-back-over-empty-lines))))
|
||
(insert "\n"))
|
||
(insert "* " org-footnote-section "\n")))
|
||
|
||
(defun org-footnote--set-label (label)
|
||
"Set label of footnote at point to string LABEL.
|
||
Assume point is at the beginning of the reference or definition
|
||
to rename."
|
||
(forward-char 4)
|
||
(cond ((eq (char-after) ?:) (insert label))
|
||
((looking-at "\\([-_[:word:]]+\\)") (replace-match label nil nil nil 1))
|
||
(t nil)))
|
||
|
||
(defun org-footnote--collect-references (&optional anonymous)
|
||
"Collect all labeled footnote references in current buffer.
|
||
|
||
Return an alist where associations follow the pattern
|
||
|
||
(LABEL MARKER TOP-LEVEL SIZE)
|
||
|
||
with
|
||
|
||
LABEL the label of the of the definition,
|
||
MARKER a marker pointing to its beginning,
|
||
TOP-LEVEL a boolean, nil when the footnote is contained within
|
||
another one,
|
||
SIZE the length of the inline definition, in characters,
|
||
or nil for non-inline references.
|
||
|
||
When optional ANONYMOUS is non-nil, also collect anonymous
|
||
references. In such cases, LABEL is nil.
|
||
|
||
References are sorted according to a deep-reading order."
|
||
(org-with-wide-buffer
|
||
(goto-char (point-min))
|
||
(let ((regexp (if anonymous org-footnote-re "\\[fn:[-_[:word:]]+[]:]"))
|
||
references nested)
|
||
(save-excursion
|
||
(while (re-search-forward regexp nil t)
|
||
;; Ignore definitions.
|
||
(unless (and (eq (char-before) ?\])
|
||
(= (line-beginning-position) (match-beginning 0)))
|
||
;; Ensure point is within the reference before parsing it.
|
||
(backward-char)
|
||
(let ((object (org-element-context)))
|
||
(when (org-element-type-p object 'footnote-reference)
|
||
(let* ((label (org-element-property :label object))
|
||
(begin (org-element-property :begin object))
|
||
(size
|
||
(and (eq (org-element-property :type object) 'inline)
|
||
(- (org-element-property :contents-end object)
|
||
(org-element-property :contents-begin object)))))
|
||
(let ((d (org-element-lineage object 'footnote-definition)))
|
||
(push (list label (copy-marker begin) (not d) size)
|
||
references)
|
||
(when d
|
||
;; Nested references are stored in alist NESTED.
|
||
;; Associations there follow the pattern
|
||
;;
|
||
;; (DEFINITION-LABEL . REFERENCES)
|
||
(let* ((def-label (org-element-property :label d))
|
||
(labels (assoc def-label nested)))
|
||
(if labels (push label (cdr labels))
|
||
(push (list def-label label) nested)))))))))))
|
||
;; Sort the list of references. Nested footnotes have priority
|
||
;; over top-level ones.
|
||
(letrec ((ordered nil)
|
||
(add-reference
|
||
(lambda (ref allow-nested)
|
||
(when (or allow-nested (nth 2 ref))
|
||
(push ref ordered)
|
||
(dolist (r (mapcar (lambda (l) (assoc l references))
|
||
(reverse
|
||
(cdr (assoc (nth 0 ref) nested)))))
|
||
(funcall add-reference r t))))))
|
||
(dolist (r (reverse references) (nreverse ordered))
|
||
(funcall add-reference r nil))))))
|
||
|
||
(defun org-footnote--collect-definitions (&optional delete)
|
||
"Collect all footnote definitions in current buffer.
|
||
|
||
Return an alist where associations follow the pattern
|
||
|
||
(LABEL . DEFINITION)
|
||
|
||
with LABEL and DEFINITION being, respectively, the label and the
|
||
definition of the footnote, as strings.
|
||
|
||
When optional argument DELETE is non-nil, delete the definition
|
||
while collecting them."
|
||
(org-with-wide-buffer
|
||
(goto-char (point-min))
|
||
(let (definitions seen)
|
||
(while (re-search-forward org-footnote-definition-re nil t)
|
||
(backward-char)
|
||
(let ((element (org-element-at-point)))
|
||
(let ((label (org-element-property :label element)))
|
||
(when (and (org-element-type-p element 'footnote-definition)
|
||
(not (member label seen)))
|
||
(push label seen)
|
||
(let* ((beg (progn
|
||
(goto-char (org-element-property :begin element))
|
||
(skip-chars-backward " \r\t\n")
|
||
(if (bobp) (point) (line-beginning-position 2))))
|
||
(end (progn
|
||
(goto-char (org-element-property :end element))
|
||
(skip-chars-backward " \r\t\n")
|
||
(line-beginning-position 2)))
|
||
(def (org-trim (buffer-substring-no-properties beg end))))
|
||
(push (cons label def) definitions)
|
||
(when delete (delete-region beg end)))))))
|
||
definitions)))
|
||
|
||
(defun org-footnote--goto-local-insertion-point ()
|
||
"Find insertion point for footnote, just before next outline heading.
|
||
Assume insertion point is within currently accessible part of the buffer."
|
||
(org-with-limited-levels (outline-next-heading))
|
||
(skip-chars-backward " \t\n")
|
||
(unless (bobp) (forward-line))
|
||
(unless (bolp) (insert "\n")))
|
||
|
||
|
||
;;;; Navigation
|
||
|
||
(defun org-footnote-get-next-reference (&optional label backward limit)
|
||
"Return complete reference of the next footnote.
|
||
|
||
If LABEL is provided, get the next reference of that footnote. If
|
||
BACKWARD is non-nil, find previous reference instead. LIMIT is
|
||
the buffer position bounding the search.
|
||
|
||
Return value is a list like those provided by `org-footnote-at-reference-p'.
|
||
If no footnote is found, return nil."
|
||
(let ((label-regexp (if label (format "\\[fn:%s[]:]" label) org-footnote-re)))
|
||
(catch :exit
|
||
(save-excursion
|
||
(while (funcall (if backward #'re-search-backward #'re-search-forward)
|
||
label-regexp limit t)
|
||
(unless backward (backward-char))
|
||
(pcase (org-footnote-at-reference-p)
|
||
(`nil nil)
|
||
(reference (throw :exit reference))))))))
|
||
|
||
(defun org-footnote-next-reference-or-definition (limit)
|
||
"Move point to next footnote reference or definition.
|
||
|
||
LIMIT is the buffer position bounding the search.
|
||
|
||
Return value is a list like those provided by
|
||
`org-footnote-at-reference-p' or `org-footnote-at-definition-p'.
|
||
If no footnote is found, return nil.
|
||
|
||
This function is meant to be used for fontification only."
|
||
(let ((origin (point)))
|
||
(catch 'exit
|
||
(while t
|
||
(unless (re-search-forward org-footnote-re limit t)
|
||
(goto-char origin)
|
||
(throw 'exit nil))
|
||
;; Beware: with non-inline footnotes point will be just after
|
||
;; the closing square bracket.
|
||
(backward-char)
|
||
(cond
|
||
((and (/= (match-beginning 0) (line-beginning-position))
|
||
(let* ((beg (match-beginning 0))
|
||
(label (match-string-no-properties 1))
|
||
;; Inline footnotes don't end at (match-end 0)
|
||
;; as `org-footnote-re' stops just after the
|
||
;; second colon. Find the real ending with
|
||
;; `scan-sexps', so Org doesn't get fooled by
|
||
;; unrelated closing square brackets.
|
||
(end (ignore-errors (scan-sexps beg 1))))
|
||
(and end
|
||
;; Verify match isn't a part of a link.
|
||
(not (save-excursion
|
||
(goto-char beg)
|
||
(let ((linkp
|
||
(save-match-data
|
||
(org-in-regexp org-link-bracket-re))))
|
||
(and linkp (< (point) (cdr linkp))))))
|
||
;; Verify point doesn't belong to a LaTeX macro.
|
||
(not (org-inside-latex-macro-p))
|
||
(throw 'exit
|
||
(list label beg end
|
||
;; Definition: ensure this is an
|
||
;; inline footnote first.
|
||
(and (match-end 2)
|
||
(org-trim
|
||
(buffer-substring-no-properties
|
||
(match-end 0) (1- end))))))))))
|
||
;; Definition: also grab the last square bracket, matched in
|
||
;; `org-footnote-re' for non-inline footnotes.
|
||
((and (save-excursion
|
||
(forward-line 0)
|
||
(save-match-data (org-footnote-in-valid-context-p)))
|
||
(save-excursion
|
||
(end-of-line)
|
||
;; Footnotes definitions are separated by new
|
||
;; headlines, another footnote definition or 2 blank
|
||
;; lines.
|
||
(let ((end (match-end 0))
|
||
(lim (save-excursion
|
||
(re-search-backward
|
||
(concat org-outline-regexp-bol
|
||
"\\|^\\([ \t]*\n\\)\\{2,\\}")
|
||
nil t))))
|
||
(and (re-search-backward org-footnote-definition-re lim t)
|
||
(throw 'exit
|
||
(list nil
|
||
(match-beginning 0)
|
||
(if (eq (char-before end) ?\]) end
|
||
(1+ end)))))))))
|
||
(t nil))))))
|
||
|
||
(defun org-footnote-goto-definition (label &optional location)
|
||
"Move point to the definition of the footnote LABEL.
|
||
|
||
LOCATION, when non-nil specifies the buffer position of the
|
||
definition.
|
||
|
||
Throw an error if there is no definition or if it cannot be
|
||
reached from current narrowed part of buffer. Return a non-nil
|
||
value if point was successfully moved."
|
||
(interactive "sLabel: ")
|
||
(let* ((label (org-footnote-normalize-label label))
|
||
(def-start (or location (nth 1 (org-footnote-get-definition label)))))
|
||
(cond
|
||
((not def-start)
|
||
(user-error "Cannot find definition of footnote %s" label))
|
||
((or (> def-start (point-max)) (< def-start (point-min)))
|
||
(user-error "Definition is outside narrowed part of buffer")))
|
||
(org-mark-ring-push)
|
||
(goto-char def-start)
|
||
(looking-at (format "\\[fn:%s[]:]" (regexp-quote label)))
|
||
(goto-char (match-end 0))
|
||
(org-fold-show-context 'link-search)
|
||
(when (derived-mode-p 'org-mode)
|
||
(message "%s" (substitute-command-keys
|
||
"Edit definition and go back with \
|
||
`\\[org-mark-ring-goto]' or, if unique, with `\\[org-ctrl-c-ctrl-c]'.")))
|
||
t))
|
||
|
||
(defun org-footnote-goto-previous-reference (label)
|
||
"Find the first closest (to point) reference of footnote with label LABEL."
|
||
(interactive "sLabel: ")
|
||
(let* ((label (org-footnote-normalize-label label))
|
||
(reference
|
||
(save-excursion
|
||
(or (org-footnote-get-next-reference label t)
|
||
(org-footnote-get-next-reference label)
|
||
(and (buffer-narrowed-p)
|
||
(org-with-wide-buffer
|
||
(or (org-footnote-get-next-reference label t)
|
||
(org-footnote-get-next-reference label)))))))
|
||
(start (nth 1 reference)))
|
||
(cond ((not reference)
|
||
(user-error "Cannot find reference of footnote %S" label))
|
||
((or (> start (point-max)) (< start (point-min)))
|
||
(user-error "Reference is outside narrowed part of buffer")))
|
||
(org-mark-ring-push)
|
||
(goto-char start)
|
||
(org-fold-show-context 'link-search)))
|
||
|
||
|
||
;;;; Getters
|
||
|
||
(defun org-footnote-normalize-label (label)
|
||
"Return LABEL without \"fn:\" prefix.
|
||
If LABEL is the empty string or constituted of white spaces only,
|
||
return nil instead."
|
||
(pcase (org-trim label)
|
||
("" nil)
|
||
((pred (string-prefix-p "fn:")) (substring label 3))
|
||
(_ label)))
|
||
|
||
(defun org-footnote-get-definition (label)
|
||
"Return label, boundaries and definition of the footnote LABEL."
|
||
(let* ((label (regexp-quote (org-footnote-normalize-label label)))
|
||
(re (format "^\\[fn:%s\\]\\|.\\[fn:%s:" label label)))
|
||
(org-with-wide-buffer
|
||
(goto-char (point-min))
|
||
(catch 'found
|
||
(while (re-search-forward re nil t)
|
||
(let* ((datum (progn (backward-char) (org-element-context)))
|
||
(type (org-element-type datum)))
|
||
(when (memq type '(footnote-definition footnote-reference))
|
||
(throw 'found
|
||
(list
|
||
label
|
||
(org-element-property :begin datum)
|
||
(org-element-property :end datum)
|
||
(let ((cbeg (org-element-property :contents-begin datum)))
|
||
(if (not cbeg) ""
|
||
(replace-regexp-in-string
|
||
"[ \t\n]*\\'"
|
||
""
|
||
(buffer-substring-no-properties
|
||
cbeg
|
||
(org-element-property :contents-end datum))))))))))
|
||
nil))))
|
||
|
||
(defun org-footnote-all-labels ()
|
||
"List all defined footnote labels used throughout the buffer.
|
||
This function ignores narrowing, if any."
|
||
(org-with-wide-buffer
|
||
(goto-char (point-min))
|
||
(let (all)
|
||
(while (re-search-forward org-footnote-re nil t)
|
||
(backward-char)
|
||
(let ((context (org-element-context)))
|
||
(when (org-element-type-p
|
||
context '(footnote-definition footnote-reference))
|
||
(let ((label (org-element-property :label context)))
|
||
(when label (cl-pushnew label all :test #'equal))))))
|
||
all)))
|
||
|
||
(defun org-footnote-unique-label (&optional current)
|
||
"Return a new unique footnote label.
|
||
|
||
The function returns the first numeric label currently unused.
|
||
|
||
Optional argument CURRENT is the list of labels active in the
|
||
buffer."
|
||
(let ((current (or current (org-footnote-all-labels))))
|
||
(let ((count 1))
|
||
(while (member (number-to-string count) current)
|
||
(cl-incf count))
|
||
(number-to-string count))))
|
||
|
||
|
||
;;;; Adding, Deleting Footnotes
|
||
|
||
(defun org-footnote-new ()
|
||
"Insert a new footnote.
|
||
This command prompts for a label. If this is a label referencing an
|
||
existing label, only insert the label. If the footnote label is empty
|
||
or new, let the user edit the definition of the footnote."
|
||
(interactive)
|
||
(unless (org-footnote--allow-reference-p)
|
||
(user-error "Cannot insert a footnote here"))
|
||
(let* ((all (org-footnote-all-labels))
|
||
(label
|
||
(if (eq org-footnote-auto-label 'random)
|
||
(format "%x" (abs (random)))
|
||
(org-footnote-normalize-label
|
||
(let ((propose (org-footnote-unique-label all)))
|
||
(if (eq org-footnote-auto-label t) propose
|
||
(completing-read
|
||
"Label (leave empty for anonymous): "
|
||
(mapcar #'list all) nil nil
|
||
(and (eq org-footnote-auto-label 'confirm) propose))))))))
|
||
(cond ((not label)
|
||
(insert "[fn::]")
|
||
(backward-char 1))
|
||
((member label all)
|
||
(insert "[fn:" label "]")
|
||
(message "New reference to existing note"))
|
||
(org-footnote-define-inline
|
||
(insert "[fn:" label ":]")
|
||
(backward-char 1)
|
||
(org-footnote-auto-adjust-maybe))
|
||
(t
|
||
(insert "[fn:" label "]")
|
||
(let ((p (org-footnote-create-definition label)))
|
||
;; `org-footnote-goto-definition' needs to be called
|
||
;; after `org-footnote-auto-adjust-maybe'. Otherwise
|
||
;; both label and location of the definition are lost.
|
||
;; On the contrary, it needs to be called before
|
||
;; `org-edit-footnote-reference' so that the remote
|
||
;; editing buffer can display the correct label.
|
||
(if (ignore-errors (org-footnote-goto-definition label p))
|
||
(org-footnote-auto-adjust-maybe)
|
||
;; Definition was created outside current scope: edit
|
||
;; it remotely.
|
||
(org-footnote-auto-adjust-maybe)
|
||
(org-edit-footnote-reference)))))))
|
||
|
||
(defun org-footnote-create-definition (label)
|
||
"Start the definition of a footnote with label LABEL.
|
||
Return buffer position at the beginning of the definition. This
|
||
function doesn't move point."
|
||
(let ((label (org-footnote-normalize-label label))
|
||
electric-indent-mode) ; Prevent wrong indentation.
|
||
(org-preserve-local-variables
|
||
(org-with-wide-buffer
|
||
(cond
|
||
((not org-footnote-section) (org-footnote--goto-local-insertion-point))
|
||
((save-excursion
|
||
(goto-char (point-min))
|
||
(re-search-forward
|
||
(concat "^\\*+[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$")
|
||
nil t))
|
||
(goto-char (match-end 0))
|
||
(org-end-of-meta-data t)
|
||
(unless (bolp) (insert "\n")))
|
||
(t (org-footnote--clear-footnote-section)))
|
||
(when (zerop (org-back-over-empty-lines)) (insert "\n"))
|
||
(insert "[fn:" label "] \n")
|
||
(line-beginning-position 0)))))
|
||
|
||
(defun org-footnote-delete-references (label)
|
||
"Delete every reference to footnote LABEL.
|
||
Return the number of footnotes removed."
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(let (ref (nref 0))
|
||
(while (setq ref (org-footnote-get-next-reference label))
|
||
(goto-char (nth 1 ref))
|
||
(delete-region (nth 1 ref) (nth 2 ref))
|
||
(cl-incf nref))
|
||
nref)))
|
||
|
||
(defun org-footnote-delete-definitions (label)
|
||
"Delete every definition of the footnote LABEL.
|
||
Return the number of footnotes removed."
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(let ((def-re (format "^\\[fn:%s\\]" (regexp-quote label)))
|
||
(ndef 0))
|
||
(while (re-search-forward def-re nil t)
|
||
(pcase (org-footnote-at-definition-p)
|
||
(`(,_ ,start ,end ,_)
|
||
;; Remove the footnote, and all blank lines before it.
|
||
(delete-region (progn
|
||
(goto-char start)
|
||
(skip-chars-backward " \r\t\n")
|
||
(if (bobp) (point) (line-beginning-position 2)))
|
||
(progn
|
||
(goto-char end)
|
||
(skip-chars-backward " \r\t\n")
|
||
(if (bobp) (point) (line-beginning-position 2))))
|
||
(cl-incf ndef))))
|
||
ndef)))
|
||
|
||
(defun org-footnote-delete (&optional label)
|
||
"Delete the footnote at point.
|
||
This will remove the definition (even multiple definitions if they exist)
|
||
and all references of a footnote label.
|
||
|
||
If LABEL is non-nil, delete that footnote instead."
|
||
(catch 'done
|
||
(org-preserve-local-variables
|
||
(let* ((nref 0) (ndef 0) x
|
||
;; 1. Determine LABEL of footnote at point.
|
||
(label (cond
|
||
;; LABEL is provided as argument.
|
||
(label)
|
||
;; Footnote reference at point. If the footnote is
|
||
;; anonymous, delete it and exit instead.
|
||
((setq x (org-footnote-at-reference-p))
|
||
(or (car x)
|
||
(progn
|
||
(delete-region (nth 1 x) (nth 2 x))
|
||
(message "Anonymous footnote removed")
|
||
(throw 'done t))))
|
||
;; Footnote definition at point.
|
||
((setq x (org-footnote-at-definition-p))
|
||
(car x))
|
||
(t (error "Don't know which footnote to remove")))))
|
||
;; 2. Now that LABEL is non-nil, find every reference and every
|
||
;; definition, and delete them.
|
||
(setq nref (org-footnote-delete-references label)
|
||
ndef (org-footnote-delete-definitions label))
|
||
;; 3. Verify consistency of footnotes and notify user.
|
||
(org-footnote-auto-adjust-maybe)
|
||
(message "%d definition(s) of and %d reference(s) of footnote %s removed"
|
||
ndef nref label)))))
|
||
|
||
|
||
;;;; Sorting, Renumbering, Normalizing
|
||
|
||
(defun org-footnote-renumber-fn:N ()
|
||
"Order numbered footnotes into a sequence in the document."
|
||
(interactive)
|
||
(let* ((c 0)
|
||
(references (cl-remove-if-not
|
||
(lambda (r) (string-match-p "\\`[0-9]+\\'" (car r)))
|
||
(org-footnote--collect-references)))
|
||
(alist (mapcar (lambda (l) (cons l (number-to-string (cl-incf c))))
|
||
(delete-dups (mapcar #'car references)))))
|
||
(org-with-wide-buffer
|
||
;; Re-number references.
|
||
(dolist (ref references)
|
||
(goto-char (nth 1 ref))
|
||
(org-footnote--set-label (cdr (assoc (nth 0 ref) alist))))
|
||
;; Re-number definitions.
|
||
(goto-char (point-min))
|
||
(while (re-search-forward "^\\[fn:\\([0-9]+\\)\\]" nil t)
|
||
(replace-match (or (cdr (assoc (match-string 1) alist))
|
||
;; Un-referenced definitions get higher
|
||
;; numbers.
|
||
(number-to-string (cl-incf c)))
|
||
nil nil nil 1)))))
|
||
|
||
(defun org-footnote-sort ()
|
||
"Rearrange footnote definitions in the current buffer.
|
||
Sort footnote definitions so they match order of footnote
|
||
references. Also relocate definitions at the end of their
|
||
relative section or within a single footnote section, according
|
||
to `org-footnote-section'. Inline definitions are ignored."
|
||
(let ((references (org-footnote--collect-references)))
|
||
(org-preserve-local-variables
|
||
(let ((definitions (org-footnote--collect-definitions 'delete)))
|
||
(org-with-wide-buffer
|
||
(org-footnote--clear-footnote-section)
|
||
;; Insert footnote definitions at the appropriate location,
|
||
;; separated by a blank line. Each definition is inserted
|
||
;; only once throughout the buffer.
|
||
(let (inserted)
|
||
(dolist (cell references)
|
||
(let ((label (car cell))
|
||
(nested (not (nth 2 cell)))
|
||
(inline (nth 3 cell)))
|
||
(unless (or (member label inserted) inline)
|
||
(push label inserted)
|
||
(unless (or org-footnote-section nested)
|
||
;; If `org-footnote-section' is non-nil, or
|
||
;; reference is nested, point is already at the
|
||
;; correct position. Otherwise, move at the
|
||
;; appropriate location within the section
|
||
;; containing the reference.
|
||
(goto-char (nth 1 cell))
|
||
(org-footnote--goto-local-insertion-point))
|
||
(insert "\n"
|
||
(or (cdr (assoc label definitions))
|
||
(format "[fn:%s] DEFINITION NOT FOUND." label))
|
||
"\n"))))
|
||
;; Insert un-referenced footnote definitions at the end.
|
||
;; Combine all insertions into one to create a single cache
|
||
;; update call.
|
||
(org-combine-change-calls (point) (point)
|
||
(pcase-dolist (`(,label . ,definition) definitions)
|
||
(unless (member label inserted)
|
||
(insert "\n" definition "\n"))))))))))
|
||
|
||
(defun org-footnote-normalize ()
|
||
"Turn every footnote in buffer into a numbered one."
|
||
(interactive)
|
||
(org-preserve-local-variables
|
||
(let ((n 0)
|
||
(translations nil)
|
||
(definitions nil)
|
||
(references (org-footnote--collect-references 'anonymous)))
|
||
(org-with-wide-buffer
|
||
;; Update label for reference. We need to do this before
|
||
;; clearing definitions in order to rename nested footnotes
|
||
;; before they are deleted.
|
||
(dolist (cell references)
|
||
(let* ((label (car cell))
|
||
(anonymous (not label))
|
||
(new
|
||
(cond
|
||
;; In order to differentiate anonymous references
|
||
;; from regular ones, set their labels to integers,
|
||
;; not strings.
|
||
(anonymous (setcar cell (cl-incf n)))
|
||
((cdr (assoc label translations)))
|
||
(t (let ((l (number-to-string (cl-incf n))))
|
||
(push (cons label l) translations)
|
||
l)))))
|
||
(goto-char (nth 1 cell)) ; Move to reference's start.
|
||
(org-footnote--set-label
|
||
(if anonymous (number-to-string new) new))
|
||
(let ((size (nth 3 cell)))
|
||
;; Transform inline footnotes into regular references and
|
||
;; retain their definition for later insertion as
|
||
;; a regular footnote definition.
|
||
(when size
|
||
(let ((def (concat
|
||
(format "[fn:%s] " new)
|
||
(org-trim
|
||
(substring
|
||
(delete-and-extract-region
|
||
(point) (+ (point) size 1))
|
||
1)))))
|
||
(push (cons (if anonymous new label) def) definitions)
|
||
(when org-footnote-fill-after-inline-note-extraction
|
||
(org-fill-paragraph)))))))
|
||
;; Collect definitions. Update labels according to ALIST.
|
||
(let ((definitions
|
||
(nconc definitions
|
||
(org-footnote--collect-definitions 'delete)))
|
||
(inserted))
|
||
(org-footnote--clear-footnote-section)
|
||
(dolist (cell references)
|
||
(let* ((label (car cell))
|
||
(anonymous (integerp label))
|
||
(pos (nth 1 cell)))
|
||
;; Move to appropriate location, if required. When there
|
||
;; is a footnote section or reference is nested, point is
|
||
;; already at the expected location.
|
||
(unless (or org-footnote-section (not (nth 2 cell)))
|
||
(goto-char pos)
|
||
(org-footnote--goto-local-insertion-point))
|
||
;; Insert new definition once label is updated.
|
||
(unless (member label inserted)
|
||
(push label inserted)
|
||
(let ((stored (cdr (assoc label definitions)))
|
||
;; Anonymous footnotes' label is already
|
||
;; up-to-date.
|
||
(new (if anonymous label
|
||
(cdr (assoc label translations)))))
|
||
(insert "\n"
|
||
(cond
|
||
((not stored)
|
||
(format "[fn:%s] DEFINITION NOT FOUND." new))
|
||
(anonymous stored)
|
||
(t
|
||
(replace-regexp-in-string
|
||
"\\`\\[fn:\\(.*?\\)\\]" new stored nil nil 1)))
|
||
"\n")))))
|
||
;; Insert un-referenced footnote definitions at the end.
|
||
(pcase-dolist (`(,label . ,definition) definitions)
|
||
(unless (member label inserted)
|
||
(insert "\n"
|
||
(replace-regexp-in-string org-footnote-definition-re
|
||
(format "[fn:%d]" (cl-incf n))
|
||
definition)
|
||
"\n"))))))))
|
||
|
||
(defun org-footnote-auto-adjust-maybe ()
|
||
"Renumber and/or sort footnotes according to user settings."
|
||
(when (memq org-footnote-auto-adjust '(t renumber))
|
||
(org-footnote-renumber-fn:N))
|
||
(when (memq org-footnote-auto-adjust '(t sort))
|
||
(let ((label (car (org-footnote-at-definition-p))))
|
||
(org-footnote-sort)
|
||
(when label
|
||
(goto-char (point-min))
|
||
(and (re-search-forward (format "^\\[fn:%s\\]" (regexp-quote label))
|
||
nil t)
|
||
(progn (insert " ")
|
||
(just-one-space)))))))
|
||
|
||
|
||
;;;; End-user interface
|
||
|
||
;;;###autoload
|
||
(defun org-footnote-action (&optional special)
|
||
"Do the right thing for footnotes.
|
||
|
||
When at a footnote reference, jump to the definition.
|
||
|
||
When at a definition, jump to the references if they exist, offer
|
||
to create them otherwise.
|
||
|
||
When neither at definition or reference, create a new footnote,
|
||
interactively if possible.
|
||
|
||
With prefix arg SPECIAL, or when no footnote can be created,
|
||
offer additional commands in a menu."
|
||
(interactive "P")
|
||
(let* ((context (and (not special) (org-element-context)))
|
||
(type (org-element-type context)))
|
||
(cond
|
||
;; On white space after element, insert a new footnote.
|
||
((and context
|
||
(> (point)
|
||
(save-excursion
|
||
(goto-char (org-element-property :end context))
|
||
(skip-chars-backward " \t")
|
||
(point))))
|
||
(org-footnote-new))
|
||
((eq type 'footnote-reference)
|
||
(let ((label (org-element-property :label context)))
|
||
(cond
|
||
;; Anonymous footnote: move point at the beginning of its
|
||
;; definition.
|
||
((not label)
|
||
(goto-char (org-element-property :contents-begin context)))
|
||
;; Check if a definition exists: then move to it.
|
||
((let ((p (nth 1 (org-footnote-get-definition label))))
|
||
(when p (org-footnote-goto-definition label p))))
|
||
;; No definition exists: offer to create it.
|
||
((yes-or-no-p (format "No definition for %s. Create one? " label))
|
||
(let ((p (org-footnote-create-definition label)))
|
||
(or (ignore-errors (org-footnote-goto-definition label p))
|
||
;; Since definition was created outside current scope,
|
||
;; edit it remotely.
|
||
(org-edit-footnote-reference)))))))
|
||
((eq type 'footnote-definition)
|
||
(org-footnote-goto-previous-reference
|
||
(org-element-property :label context)))
|
||
((or special (not (org-footnote--allow-reference-p)))
|
||
(message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s | [n]ormalize | \
|
||
\[d]elete")
|
||
(pcase (read-char-exclusive)
|
||
(?s (org-footnote-sort))
|
||
(?r (org-footnote-renumber-fn:N))
|
||
(?S (org-footnote-renumber-fn:N)
|
||
(org-footnote-sort))
|
||
(?n (org-footnote-normalize))
|
||
(?d (org-footnote-delete))
|
||
(char (error "No such footnote command %c" char))))
|
||
(t (org-footnote-new)))))
|
||
|
||
|
||
(provide 'org-footnote)
|
||
|
||
;; Local variables:
|
||
;; generated-autoload-file: "org-loaddefs.el"
|
||
;; End:
|
||
|
||
;;; org-footnote.el ends here
|