diff options
Diffstat (limited to '.emacs.d/elpa/org-20171120/org-footnote.el')
| -rw-r--r-- | .emacs.d/elpa/org-20171120/org-footnote.el | 1005 |
1 files changed, 1005 insertions, 0 deletions
diff --git a/.emacs.d/elpa/org-20171120/org-footnote.el b/.emacs.d/elpa/org-20171120/org-footnote.el new file mode 100644 index 0000000..e039ab7 --- /dev/null +++ b/.emacs.d/elpa/org-20171120/org-footnote.el @@ -0,0 +1,1005 @@ +;;; org-footnote.el --- Footnote support in Org -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://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-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)) +(declare-function org-in-block-p "org" (names)) +(declare-function org-in-regexp "org" (re &optional nlines visually)) +(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 org-trim "org" (s &optional keep-lead)) +(declare-function outline-next-heading "outline") + +(defvar electric-indent-mode) +(defvar org-blank-before-new-entry) ; defined in org.el +(defvar org-bracket-link-regexp) ; 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))) + +(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) + +(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))) + +(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))) + +(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) + + +;;;; 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 () + "Is the cursor at a footnote reference? + +If so, return a list containing its label, beginning and ending +positions, and the definition, when inlined." + (when (and (org-footnote-in-valid-context-p) + (or (looking-at org-footnote-re) + (org-in-regexp org-footnote-re) + (save-excursion (re-search-backward org-footnote-re nil t))) + (/= (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)))) + ;; Point is really at a reference if it's located before true + ;; ending of the footnote. + (when (and end + (< (point) 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-bracket-link-regexp)))) + (and linkp (< (point) (cdr linkp)))))) + ;; Verify point doesn't belong to a LaTeX macro. + (not (org-inside-latex-macro-p))) + (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))))))))) + +(defun org-footnote-at-definition-p () + "Is point within a footnote definition? + +This matches only pure definitions like [1] or [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 will be nil if not at a footnote definition, and +a list with label, start, end and definition of the footnote +otherwise." + (when (save-excursion (beginning-of-line) (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 ((lim (save-excursion + (re-search-backward + (concat org-outline-regexp-bol + "\\|^\\([ \t]*\n\\)\\{2,\\}") nil t)))) + (when (re-search-backward org-footnote-definition-re lim t) + (let ((label (match-string-no-properties 1)) + (beg (match-beginning 0)) + (beg-def (match-end 0)) + (end (if (progn + (end-of-line) + (re-search-forward + (concat org-outline-regexp-bol "\\|" + org-footnote-definition-re "\\|" + "^\\([ \t]*\n\\)\\{2,\\}") nil 'move)) + (match-beginning 0) + (point)))) + (list label beg end + (org-trim (buffer-substring-no-properties beg-def end))))))))) + + +;;;; 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) + (1+ (line-beginning-position 2)))))) + ;; 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) + ((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, before any file +local variable definition. 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) + (progn (org-end-of-subtree t t) + (if (not (eobp)) (point) + (org-footnote--goto-local-insertion-point) + (skip-chars-forward " \t\n") + (if (eobp) (point) (line-beginning-position))))))) + (goto-char (point-max)) + (org-footnote--goto-local-insertion-point) + (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 file local variables. See `modify-file-local-variable'. + (when (eobp) + (let ((case-fold-search t)) + (re-search-backward "^[ \t]*# +Local Variables:" + (max (- (point-max) 3000) (point-min)) + t))) + (skip-chars-backward " \t\n") + (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." + (save-excursion + (let* ((label-fmt (if label (format "\\[fn:%s[]:]" label) org-footnote-re))) + (catch 'exit + (while t + (unless (funcall (if backward #'re-search-backward #'re-search-forward) + label-fmt limit t) + (throw 'exit nil)) + (unless backward (backward-char)) + (let ((ref (org-footnote-at-reference-p))) + (when ref (throw 'exit ref)))))))) + +(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." + (let* (ref (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 + ((setq ref (org-footnote-at-reference-p)) + (throw 'exit ref)) + ;; Definition: also grab the last square bracket, matched in + ;; `org-footnote-re' for non-inline footnotes. + ((save-match-data (org-footnote-at-definition-p)) + (let ((end (match-end 0))) + (throw 'exit + (list nil (match-beginning 0) + (if (eq (char-before end) ?\]) end (1+ end))))))))))) + +(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: ") + (org-mark-ring-push) + (let ((label (org-footnote-normalize-label label)) + ref) + (save-excursion + (setq ref (or (org-footnote-get-next-reference label t) + (org-footnote-get-next-reference label) + (save-restriction + (widen) + (or + (org-footnote-get-next-reference label t) + (org-footnote-get-next-reference label)))))) + (if (not ref) + (error "Cannot find reference of footnote %s" label) + (goto-char (nth 1 ref)) + (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" (random most-positive-fixnum)) + (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-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)) + (forward-line) + (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 + (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 ((references (org-footnote--collect-references))) + (unwind-protect + (let* ((c 0) + (references (cl-remove-if-not + (lambda (r) (string-match-p "\\`[0-9]+\\'" (car r))) + 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)))) + (dolist (r references) (set-marker (nth 1 r) nil))))) + +(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))) + (unwind-protect + (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. + (let ((unreferenced + (cl-remove-if (lambda (d) (member (car d) inserted)) + definitions))) + (dolist (d unreferenced) (insert "\n" (cdr d) "\n")))))) + ;; Clear dangling markers in the buffer. + (dolist (r references) (set-marker (nth 1 r) nil))))) + +(defun org-footnote-normalize () + "Turn every footnote in buffer into a numbered one." + (interactive) + (let ((references (org-footnote--collect-references 'anonymous))) + (unwind-protect + (let ((n 0) + (translations nil) + (definitions nil)) + (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. + (let ((unreferenced + (cl-remove-if (lambda (d) (member (car d) inserted)) + definitions))) + (dolist (d unreferenced) + (insert "\n" + (replace-regexp-in-string + org-footnote-definition-re + (format "[fn:%d]" (cl-incf n)) + (cdr d)) + "\n")))))) + ;; Clear dangling markers. + (dolist (r references) (set-marker (nth 1 r) nil))))) + +(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 |