From 40a149354c4e5992abac467d69c1438dd1ba750b Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Tue, 30 Dec 2008 23:40:14 +0100 Subject: [PATCH] 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 | 391 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 391 insertions(+) create mode 100644 lisp/org-footnote.el diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el new file mode 100644 index 000000000..10035f121 --- /dev/null +++ b/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 +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; 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 \ No newline at end of file