mirror of https://github.com/Chizi123/.emacs.d.git

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