Footnotes: Add new file org-footnotes.el

This new files contains Org-modes new footnote support.  See the
documentation for details on how things work.

lisp/org-footnote.el

@@ -0,0 +1,391 @@
+;;; org-footnote.el --- Footnote support in Org and elsewhere
+;;
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 6.16trans
+;;
+;; 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 <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the code dealing with footnotes in Org-mode.
+;; The code can also be used in arbitrary text modes to provide
+;; footnotes.  Compared to Steven L Baur's footnote.el it provides
+;; better support for resuming editing.  It is less configurable than
+;; Steve's code, though.
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+(require 'org-macs)
+(require 'org-compat)
+
+(declare-function org-in-regexp "org" (re &optional nlines visually))
+(declare-function org-mark-ring-push "org" (&optional pos buffer))
+(declare-function outline-next-heading "outline")
+(declare-function org-trim "org" (s))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-end-of-subtree "org"  (&optional invisible-ok to-heading))
+
+(defconst org-footnote-re
+  (concat "."   ; to make sure it is not at the beginning of a line
+	  "\\["
+	  "\\(?:"
+	  "\\([0-9]+\\)"
+	  "\\|"
+	  "\\(fn:\\(\\sw+?\\)?\\)\\(?::\\([^\]]*?\\)\\)?"
+	  "\\)"
+	  "\\]")
+  "Regular expression for matching footnotes.")
+
+(defconst org-footnote-definition-re "^\\(\\[\\([0-9]+\\|fn:\\sw+\\)\\]\\)"
+  "Regular expression matching the definition of a footnote.")
+
+(defcustom org-footnote-section "Footnotes"
+  "Outline heading containing footnote definitions before export.
+During editing, Org-mode places footnote definitions under this
+special outline heading.  You can have several such sections in a buffer,
+Org-mode will always use the nearest.  So, for example, each top-level
+heading could have its own level-2 child for footnotes.
+This is the heading where Org places the definition automatically.  However,
+by hand you may place definitions *anywhere*.
+During export, all subtrees starting with this heading will be removed."
+  :group 'org-footnotes
+  :type 'string)
+
+(defcustom org-footnote-tag-for-non-org-mode-files "Footnotes:"
+  "Tag marking the beginning of footnote section.
+The Org-mode footnote engine can be used in arbitrary text files as well
+as in Org-mode.  Outside Org-mode, new footnotes are always placed at
+the end of the file.  When you normalize the notes, any line containing
+only this tag will be removed, a new one will be inserted at the end
+of the file, followed by the collected and normalized footnotes."
+  :group 'org-footnotes
+  :type 'string)
+
+(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)
+
+(defun org-footnote-at-reference-p ()
+  "Is the cursor at a footnote reference?
+If yes, return the beginning position, the label, and the definition, if local."
+  (when (org-in-regexp org-footnote-re 15)
+    (list (match-beginning 0)
+	  (or (match-string 1) 
+	      (if (equal (match-string 2) "fn:") nil (match-string 2)))
+	  (match-string 4))))
+
+(defun org-footnote-at-definition-p ()
+  "Is the cursor at a footnote definition.
+This matches only pure definitions like [1] or [fn:name] at the beginning
+of a line.  It does not a references like [fn:name:definition], where the
+footnote text is included and defined locally.
+The return value will be nil if not at a foornote definition, and a list
+with start and label of the footnote if there is a definition at point."
+  (save-excursion
+    (end-of-line 1)
+    (let ((lim (save-excursion (re-search-backward "^\\*+ \\|^[ \t]*$" nil t))))
+      (when (re-search-backward
+	     org-footnote-definition-re
+	     (save-excursion (re-search-backward "^\\*+ \\|^[ \t]*$" nil t))
+	     t)
+	(list (match-beginning 0) (match-string 2))))))
+
+(defun org-footnote-goto-definition (label)
+  "Find the definition of the footnote with label LABEL."
+  (interactive "sLabel: ")
+  (org-mark-ring-push)
+  (setq label (org-footnote-normalize-label label))
+  (let ((re (format "^\\[%s\\]\\|.\\[%s:" label label))
+	pos)
+    (save-excursion
+      (setq pos (or (re-search-forward re nil t)
+		    (and (goto-char (point-min))
+			 (re-search-forward re nil t))
+		    (and (progn (widen) t)
+			 (goto-char (point-min))
+			 (re-search-forward re nil t)))))
+    (if (not pos)
+	(error "Cannot find definition of footnote %s" label)
+      (goto-char pos)
+      (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
+
+(defun org-footnote-goto-next-reference (label)
+  "Find the definition of the footnote with label LABEL."
+  (interactive "sLabel: ")
+  (org-mark-ring-push)
+  (setq label (org-footnote-normalize-label label))
+  (let ((re (format ".\\[%s[]:]" label))
+	(p0 (point)) pos)
+    (save-excursion
+      (setq pos (or (re-search-forward re nil t)
+		    (and (goto-char (point-min))
+			 (re-search-forward re nil t))
+		    (and (progn (widen) t)
+			 (goto-char p0)
+			 (re-search-forward re nil t))
+		    (and (goto-char (point-min))
+			 (re-search-forward re nil t)))))
+    (if pos (goto-char pos)
+      (error "Cannot find reference of footnote %s" label))))
+
+(defun org-footnote-normalize-label (label)
+  (if (numberp label) (setq label (number-to-string label)))
+  (if (not (string-match "^[0-9]+$\\|^$\\|^fn:" label))
+      (setq label (concat "fn:" label)))
+  label)
+
+(defun org-footnote-all-labels ()
+  "Return list with all defined foot labels used in the buffer."
+  (let (rtn l)
+    (save-excursion
+      (save-restriction
+	(widen)
+	(goto-char (point-min))
+	(while (re-search-forward org-footnote-definition-re nil t)
+	  (setq l (org-match-string-no-properties 2))
+	  (and l (add-to-list 'rtn l)))
+	(goto-char (point-min))
+	(while (re-search-forward org-footnote-re nil t)
+	  (setq l (or (org-match-string-no-properties 1)
+		      (org-match-string-no-properties 2)))
+	  (and l (not (equal l "fn:")) (add-to-list 'rtn l)))))
+    rtn))
+
+(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)
+  (let* ((labels (org-footnote-all-labels))
+	 (label (completing-read
+		 "Label (leave empty for anonymous): "
+		 (mapcar 'list labels))))
+    (setq label (org-footnote-normalize-label label))
+    (cond
+     ((equal label "")
+      (insert "[fn:: ]")
+      (backward-char 1))
+     ((member label labels)
+      (insert "[" label "]")
+      (message "New reference to existing note"))
+     (org-footnote-define-inline
+      (insert "[" label ": ]")
+      (backward-char 1))
+     (t
+      (insert "[" label "]")
+      (org-footnote-create-definition label)))))
+
+(defun org-footnote-create-definition (label)
+  "Start the definition of a footnote with label LABEL."
+  (interactive "sLabel: ")
+  (setq label (org-footnote-normalize-label label))
+  (let (re p)
+    (cond
+     ((org-mode-p)
+      (setq re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$"))
+      (unless (or (re-search-forward re nil t)
+		  (and (progn (widen) t)
+		       (re-search-forward re nil t)))
+	(goto-char (point-max))
+	(insert "\n\n* " org-footnote-section))
+      (outline-next-heading)
+      (setq p (point))
+      (skip-chars-backward " \t\n\r")
+      (delete-region (point) p))
+     (t
+      (setq re (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$"))
+      (unless (re-search-forward re nil t)
+	(goto-char (point-max))
+	(skip-chars-backward " \t\r\n")
+	(insert "\n\n")
+	(delete-region (point) (point-max))
+	(insert org-footnote-tag-for-non-org-mode-files "\n"))
+      (goto-char (point-max))
+      (skip-chars-backward " \t\r\n")
+      (delete-region (point) (point-max))))
+    (insert "\n\n\n")
+    (backward-char 1)
+    (insert "[" label "] ")
+    (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))
+
+;;;###autoload
+(defun org-footnote-action (&optional special)
+  "Do the right thing for footnotes.
+When at a foornote reference, jump to the definition.  When at a definition,
+jump to the refernces.  When neither at definition or reference,
+create a new footnote, interactively.
+With prefix arg SPECIAL, offer additional commands in a menu."
+  (interactive "P")
+  (let (tmp c)
+    (cond
+     (special
+      (message "Footnotes: [s]ort  |  convert to [n]umeric  |  [d]elete")
+      (setq c (read-char-exclusive))
+      (cond
+       ((equal c ?s)
+	(org-footnote-normalize 'sort))
+       ((equal c ?n)
+	(org-footnote-normalize))
+       ((equal c ?d)
+	(org-footnote-delete))
+       (t (error "No such footnote command %c" c))))
+     ((setq tmp (org-footnote-at-reference-p))
+      (if (nth 1 tmp)
+	  (org-footnote-goto-definition (nth 1 tmp))
+	(goto-char (match-beginning 4))))
+     ((setq tmp (org-footnote-at-definition-p))
+      (org-footnote-goto-next-reference (nth 1 tmp)))
+     (t (org-footnote-new)))))
+
+;;;###autoload
+(defun org-footnote-normalize (&optional sort-only for-preprocessor)
+  "Collect the footnotes in various formats and normalize them.
+This find the different sorts of footnotes allowed in Org, and
+normalizes them to the usual [N] format that is understood by the
+Org-mode exporters.
+When SORT-ONLY is set, only sort the footnote definitions into the
+referenced sequence."
+  ;; This is based on Paul's function, but rewritten.
+  (let ((count 0) ref def ref-table liste beg beg1 ref def marker a before
+	ins-point)
+     (save-excursion
+      ;; Now find footnote references,
+      (goto-char (point-min))
+      (while (re-search-forward org-footnote-re nil t)
+	(org-if-unprotected
+	 (setq def (match-string 4)
+	       ref (or (match-string 1) (match-string 2))
+	       before (char-to-string (char-after (match-beginning 0))))
+	 (if (and ref (setq a (assoc ref ref-table)))
+	     (setq marker (nth 1 a))
+	   (setq marker (number-to-string (incf count))))
+	 (save-match-data
+	   (if def
+	       (setq def (org-trim def))
+	     (save-excursion
+	       (if (not (re-search-forward (concat "^\\[" ref "\\]") nil t))
+		   (setq def
+			 (format "FOOTNOTE DEFINITION NOT FOUND: %s" ref))
+		 (setq beg (match-beginning 0))
+		 (setq beg1 (match-end 0))
+		 (re-search-forward "^[ \t]*$\\|^\\[\\([0-9]+\\|fn:\\sw+\\)\\]"
+				    nil 'move)
+		 (setq def (buffer-substring beg1 (match-beginning 0)))
+		 (delete-region beg (match-beginning 0))))))
+	 (unless sort-only (replace-match (concat before "[" marker "]")))
+	 (if (not a) (push (list ref marker def) ref-table))))
+      
+      ;; First find and remove the footnote section
+      (goto-char (point-min))
+      (cond
+       ((org-mode-p)
+	(if (re-search-forward
+	     (concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
+		     "[ \t]*$")
+	     nil t)
+	    (if for-preprocessor
+		(replace-match "")
+	      (org-back-to-heading t)
+	      (forward-line 1)
+	      (setq ins-point (point))
+	      (delete-region (point) (org-end-of-subtree t)))
+	  (goto-char (point-max))
+	  (unless for-preprocessor
+	    (insert "* " org-footnote-section "\n")
+	    (setq ins-point (point)))))
+       (t
+	(if (re-search-forward 
+	     (concat "^"
+		     (regexp-quote org-footnote-tag-for-non-org-mode-files)
+		     "[ \t]*$")
+	     nil t)
+	    (replace-match ""))
+	(goto-char (point-max))
+	(skip-chars-backward " \t\n\r")
+	(delete-region (point) (point-max))
+	(insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n")
+	(setq ins-point (point))))
+
+      ;; Insert the footnotes again
+      (goto-char (or ins-point (point-max)))
+      (setq ref-table (reverse ref-table))
+      (when sort-only
+	(setq ref-table
+	      (delq nil (mapcar
+			 (lambda (x) (and (car x)
+					  (not (equal (car x) "fn:"))
+					  x))
+			 ref-table))))
+      (setq def
+	    (mapconcat
+	     (lambda (x)
+	       (format "[%s] %s" (nth (if sort-only 0 1) x)
+		       (org-trim (nth 2 x))))
+	     ref-table "\n\n"))
+      (if ref-table (insert "\n" def "\n\n")))))
+
+(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."
+  (catch 'done
+    (let (x label l beg def-re (nref 0) (ndef 0))
+      (unless label
+	(when (setq x (org-footnote-at-reference-p))
+	  (setq label (nth 1 x))
+	  (when (or (not label) (equal "fn:" label))
+	    (delete-region (1+ (match-beginning 0)) (match-end 0))
+	    (message "Anonymous footnote removed")
+	    (throw 'done t)))
+	(when (and (not label) (setq x (org-footnote-at-definition-p)))
+	  (setq label (nth 1 x)))
+	(unless label (error "Don't know which footnote to remove")))
+      (save-excursion
+	(save-restriction
+	  (goto-char (point-min))
+	  (while (re-search-forward org-footnote-re nil t)
+	    (setq l (or (match-string 1) (match-string 2)))
+	    (when (equal l label)
+	      (delete-region (1+ (match-beginning 0)) (match-end 0))
+	      (incf nref)))
+	  (goto-char (point-min))
+	  (setq def-re (concat "^\\[" (regexp-quote label) "\\]"))
+	  (while (re-search-forward def-re nil t)
+	    (setq beg (match-beginning 0))
+	    (if (re-search-forward "^\\[\\|^[ \t]*$\\|^\\*+ " nil t)
+		(goto-char (match-beginning 0))
+	      (goto-char (point-max)))
+	    (delete-region beg (point))
+	    (incf ndef))))
+      (message "%d definition(s) of and %d reference(s) of footnote %s removed"
+	       ndef nref label))))
+
+(provide 'org-footnote)
+
+;; arch-tag: 1b5954df-fb5d-4da5-8709-78d944dbfc37
+;;; org-footnote.el ends here