.emacs.d.git - Gitblit

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