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, 0 insertions, 1023 deletions
diff --git a/elpa/org-9.5.2/org-footnote.el b/elpa/org-9.5.2/org-footnote.el deleted file mode 100644 index fcc7579..0000000 --- a/elpa/org-9.5.2/org-footnote.el +++ /dev/null @@ -1,1023 +0,0 @@ -;;; 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 |