diff options
Diffstat (limited to 'elpa/org-9.5.2/org-footnote.el')
| -rw-r--r-- | elpa/org-9.5.2/org-footnote.el | 1023 |
1 files changed, 1023 insertions, 0 deletions
diff --git a/elpa/org-9.5.2/org-footnote.el b/elpa/org-9.5.2/org-footnote.el new file mode 100644 index 0000000..fcc7579 --- /dev/null +++ b/elpa/org-9.5.2/org-footnote.el @@ -0,0 +1,1023 @@ +;;; org-footnote.el --- Footnote support in Org -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2009-2021 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten.dominik@gmail.com> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: 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: + +;;;; 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" ()) +(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" (blob &optional types with-self)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(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-show-context "org" (&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. If can also be 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 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 + (beginning-of-line) + (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 (eq 'footnote-reference (org-element-type 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 + (beginning-of-line) + (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 (eq (org-element-type 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 (eq (org-element-type 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 + (beginning-of-line) + (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-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-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 (memq (org-element-type 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. + (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 |