lisp/org-footnote.el

   1 ;;; org-footnote.el --- Footnote support in Org and elsewhere
   2 ;;
   3 ;; Copyright (C) 2009 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   6 ;; Keywords: outlines, hypermedia, calendar, wp
   7 ;; Homepage: http://orgmode.org
   8 ;; Version: 6.16trans
   9 ;;
  10 ;; This file is part of GNU Emacs.
  11 ;;
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25 ;;
  26 ;;; Commentary:
  27
  28 ;; This file contains the code dealing with footnotes in Org-mode.
  29 ;; The code can also be used in arbitrary text modes to provide
  30 ;; footnotes.  Compared to Steven L Baur's footnote.el it provides
  31 ;; better support for resuming editing.  It is less configurable than
  32 ;; Steve's code, though.
  33
  34 ;;; Code:
  35
  36 (eval-when-compile
  37   (require 'cl))
  38 (require 'org-macs)
  39 (require 'org-compat)
  40
  41 (declare-function org-in-regexp "org" (re &optional nlines visually))
  42 (declare-function org-mark-ring-push "org" (&optional pos buffer))
  43 (declare-function outline-next-heading "outline")
  44 (declare-function org-trim "org" (s))
  45 (declare-function org-back-to-heading "org" (&optional invisible-ok))
  46 (declare-function org-end-of-subtree "org"  (&optional invisible-ok to-heading))
  47
  48 (defconst org-footnote-re
  49   (concat "."   ; to make sure it is not at the beginning of a line
  50           "\\["
  51           "\\(?:"
  52           "\\([0-9]+\\)"
  53           "\\|"
  54           "\\(fn:\\(\\sw+?\\)?\\)\\(?::\\([^\]]*?\\)\\)?"
  55           "\\)"
  56           "\\]")
  57   "Regular expression for matching footnotes.")
  58
  59 (defconst org-footnote-definition-re "^\\(\\[\\([0-9]+\\|fn:\\sw+\\)\\]\\)"
  60   "Regular expression matching the definition of a footnote.")
  61
  62 (defcustom org-footnote-section "Footnotes"
  63   "Outline heading containing footnote definitions before export.
  64 During editing, Org-mode places footnote definitions under this
  65 special outline heading.  You can have several such sections in a buffer,
  66 Org-mode will always use the nearest.  So, for example, each top-level
  67 heading could have its own level-2 child for footnotes.
  68 This is the heading where Org places the definition automatically.  However,
  69 by hand you may place definitions *anywhere*.
  70 During export, all subtrees starting with this heading will be removed."
  71   :group 'org-footnotes
  72   :type 'string)
  73
  74 (defcustom org-footnote-tag-for-non-org-mode-files "Footnotes:"
  75   "Tag marking the beginning of footnote section.
  76 The Org-mode footnote engine can be used in arbitrary text files as well
  77 as in Org-mode.  Outside Org-mode, new footnotes are always placed at
  78 the end of the file.  When you normalize the notes, any line containing
  79 only this tag will be removed, a new one will be inserted at the end
  80 of the file, followed by the collected and normalized footnotes."
  81   :group 'org-footnotes
  82   :type 'string)
  83
  84 (defcustom org-footnote-define-inline nil
  85   "Non-nil means, define footnotes inline, at reference location.
  86 When nil, footnotes will be defined in a special section near
  87 the end of the document.  When t, the [fn:label:definition] notation
  88 will be used to define the footnote at the reference position."
  89   :group 'org-footnote
  90   :type 'boolean)
  91
  92 (defun org-footnote-at-reference-p ()
  93   "Is the cursor at a footnote reference?
  94 If yes, return the beginning position, the label, and the definition, if local."
  95   (when (org-in-regexp org-footnote-re 15)
  96     (list (match-beginning 0)
  97           (or (match-string 1)
  98               (if (equal (match-string 2) "fn:") nil (match-string 2)))
  99           (match-string 4))))
 100
 101 (defun org-footnote-at-definition-p ()
 102   "Is the cursor at a footnote definition.
 103 This matches only pure definitions like [1] or [fn:name] at the beginning
 104 of a line.  It does not a references like [fn:name:definition], where the
 105 footnote text is included and defined locally.
 106 The return value will be nil if not at a foornote definition, and a list
 107 with start and label of the footnote if there is a definition at point."
 108   (save-excursion
 109     (end-of-line 1)
 110     (let ((lim (save-excursion (re-search-backward "^\\*+ \\|^[ \t]*$" nil t))))
 111       (when (re-search-backward
 112              org-footnote-definition-re
 113              (save-excursion (re-search-backward "^\\*+ \\|^[ \t]*$" nil t))
 114              t)
 115         (list (match-beginning 0) (match-string 2))))))
 116
 117 (defun org-footnote-goto-definition (label)
 118   "Find the definition of the footnote with label LABEL."
 119   (interactive "sLabel: ")
 120   (org-mark-ring-push)
 121   (setq label (org-footnote-normalize-label label))
 122   (let ((re (format "^\\[%s\\]\\|.\\[%s:" label label))
 123         pos)
 124     (save-excursion
 125       (setq pos (or (re-search-forward re nil t)
 126                     (and (goto-char (point-min))
 127                          (re-search-forward re nil t))
 128                     (and (progn (widen) t)
 129                          (goto-char (point-min))
 130                          (re-search-forward re nil t)))))
 131     (if (not pos)
 132         (error "Cannot find definition of footnote %s" label)
 133       (goto-char pos)
 134       (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
 135
 136 (defun org-footnote-goto-next-reference (label)
 137   "Find the definition of the footnote with label LABEL."
 138   (interactive "sLabel: ")
 139   (org-mark-ring-push)
 140   (setq label (org-footnote-normalize-label label))
 141   (let ((re (format ".\\[%s[]:]" label))
 142         (p0 (point)) pos)
 143     (save-excursion
 144       (setq pos (or (re-search-forward re nil t)
 145                     (and (goto-char (point-min))
 146                          (re-search-forward re nil t))
 147                     (and (progn (widen) t)
 148                          (goto-char p0)
 149                          (re-search-forward re nil t))
 150                     (and (goto-char (point-min))
 151                          (re-search-forward re nil t)))))
 152     (if pos (goto-char pos)
 153       (error "Cannot find reference of footnote %s" label))))
 154
 155 (defun org-footnote-normalize-label (label)
 156   (if (numberp label) (setq label (number-to-string label)))
 157   (if (not (string-match "^[0-9]+$\\|^$\\|^fn:" label))
 158       (setq label (concat "fn:" label)))
 159   label)
 160
 161 (defun org-footnote-all-labels ()
 162   "Return list with all defined foot labels used in the buffer."
 163   (let (rtn l)
 164     (save-excursion
 165       (save-restriction
 166         (widen)
 167         (goto-char (point-min))
 168         (while (re-search-forward org-footnote-definition-re nil t)
 169           (setq l (org-match-string-no-properties 2))
 170           (and l (add-to-list 'rtn l)))
 171         (goto-char (point-min))
 172         (while (re-search-forward org-footnote-re nil t)
 173           (setq l (or (org-match-string-no-properties 1)
 174                       (org-match-string-no-properties 2)))
 175           (and l (not (equal l "fn:")) (add-to-list 'rtn l)))))
 176     rtn))
 177
 178 (defun org-footnote-new ()
 179   "Insert a new footnote.
 180 This command prompts for a label.  If this is a label referencing an
 181 existing label, only insert the label.  If the footnote label is empty
 182 or new, let the user edit the definition of the footnote."
 183   (interactive)
 184   (let* ((labels (org-footnote-all-labels))
 185          (label (completing-read
 186                  "Label (leave empty for anonymous): "
 187                  (mapcar 'list labels))))
 188     (setq label (org-footnote-normalize-label label))
 189     (cond
 190      ((equal label "")
 191       (insert "[fn:: ]")
 192       (backward-char 1))
 193      ((member label labels)
 194       (insert "[" label "]")
 195       (message "New reference to existing note"))
 196      (org-footnote-define-inline
 197       (insert "[" label ": ]")
 198       (backward-char 1))
 199      (t
 200       (insert "[" label "]")
 201       (org-footnote-create-definition label)))))
 202
 203 (defun org-footnote-create-definition (label)
 204   "Start the definition of a footnote with label LABEL."
 205   (interactive "sLabel: ")
 206   (setq label (org-footnote-normalize-label label))
 207   (let (re p)
 208     (cond
 209      ((org-mode-p)
 210       (setq re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$"))
 211       (unless (or (re-search-forward re nil t)
 212                   (and (progn (widen) t)
 213                        (re-search-forward re nil t)))
 214         (goto-char (point-max))
 215         (insert "\n\n* " org-footnote-section))
 216       (outline-next-heading)
 217       (setq p (point))
 218       (skip-chars-backward " \t\n\r")
 219       (delete-region (point) p))
 220      (t
 221       (setq re (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$"))
 222       (unless (re-search-forward re nil t)
 223         (goto-char (point-max))
 224         (skip-chars-backward " \t\r\n")
 225         (insert "\n\n")
 226         (delete-region (point) (point-max))
 227         (insert org-footnote-tag-for-non-org-mode-files "\n"))
 228       (goto-char (point-max))
 229       (skip-chars-backward " \t\r\n")
 230       (delete-region (point) (point-max))))
 231     (insert "\n\n\n")
 232     (backward-char 1)
 233     (insert "[" label "] ")
 234     (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))
 235
 236 ;;;###autoload
 237 (defun org-footnote-action (&optional special)
 238   "Do the right thing for footnotes.
 239 When at a foornote reference, jump to the definition.  When at a definition,
 240 jump to the refernces.  When neither at definition or reference,
 241 create a new footnote, interactively.
 242 With prefix arg SPECIAL, offer additional commands in a menu."
 243   (interactive "P")
 244   (let (tmp c)
 245     (cond
 246      (special
 247       (message "Footnotes: [s]ort  |  convert to [n]umeric  |  [d]elete")
 248       (setq c (read-char-exclusive))
 249       (cond
 250        ((equal c ?s)
 251         (org-footnote-normalize 'sort))
 252        ((equal c ?n)
 253         (org-footnote-normalize))
 254        ((equal c ?d)
 255         (org-footnote-delete))
 256        (t (error "No such footnote command %c" c))))
 257      ((setq tmp (org-footnote-at-reference-p))
 258       (if (nth 1 tmp)
 259           (org-footnote-goto-definition (nth 1 tmp))
 260         (goto-char (match-beginning 4))))
 261      ((setq tmp (org-footnote-at-definition-p))
 262       (org-footnote-goto-next-reference (nth 1 tmp)))
 263      (t (org-footnote-new)))))
 264
 265 ;;;###autoload
 266 (defun org-footnote-normalize (&optional sort-only for-preprocessor)
 267   "Collect the footnotes in various formats and normalize them.
 268 This find the different sorts of footnotes allowed in Org, and
 269 normalizes them to the usual [N] format that is understood by the
 270 Org-mode exporters.
 271 When SORT-ONLY is set, only sort the footnote definitions into the
 272 referenced sequence."
 273   ;; This is based on Paul's function, but rewritten.
 274   (let ((count 0) ref def ref-table liste beg beg1 ref def marker a before
 275         ins-point)
 276      (save-excursion
 277       ;; Now find footnote references,
 278       (goto-char (point-min))
 279       (while (re-search-forward org-footnote-re nil t)
 280         (org-if-unprotected
 281          (setq def (match-string 4)
 282                ref (or (match-string 1) (match-string 2))
 283                before (char-to-string (char-after (match-beginning 0))))
 284          (if (and ref (setq a (assoc ref ref-table)))
 285              (setq marker (nth 1 a))
 286            (setq marker (number-to-string (incf count))))
 287          (save-match-data
 288            (if def
 289                (setq def (org-trim def))
 290              (save-excursion
 291                (if (not (re-search-forward (concat "^\\[" ref "\\]") nil t))
 292                    (setq def
 293                          (format "FOOTNOTE DEFINITION NOT FOUND: %s" ref))
 294                  (setq beg (match-beginning 0))
 295                  (setq beg1 (match-end 0))
 296                  (re-search-forward "^[ \t]*$\\|^\\[\\([0-9]+\\|fn:\\sw+\\)\\]"
 297                                     nil 'move)
 298                  (setq def (buffer-substring beg1 (match-beginning 0)))
 299                  (delete-region beg (match-beginning 0))))))
 300          (unless sort-only (replace-match (concat before "[" marker "]")))
 301          (if (not a) (push (list ref marker def) ref-table))))
 302
 303       ;; First find and remove the footnote section
 304       (goto-char (point-min))
 305       (cond
 306        ((org-mode-p)
 307         (if (re-search-forward
 308              (concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
 309                      "[ \t]*$")
 310              nil t)
 311             (if for-preprocessor
 312                 (replace-match "")
 313               (org-back-to-heading t)
 314               (forward-line 1)
 315               (setq ins-point (point))
 316               (delete-region (point) (org-end-of-subtree t)))
 317           (goto-char (point-max))
 318           (unless for-preprocessor
 319             (insert "* " org-footnote-section "\n")
 320             (setq ins-point (point)))))
 321        (t
 322         (if (re-search-forward
 323              (concat "^"
 324                      (regexp-quote org-footnote-tag-for-non-org-mode-files)
 325                      "[ \t]*$")
 326              nil t)
 327             (replace-match ""))
 328         (goto-char (point-max))
 329         (skip-chars-backward " \t\n\r")
 330         (delete-region (point) (point-max))
 331         (insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n")
 332         (setq ins-point (point))))
 333
 334       ;; Insert the footnotes again
 335       (goto-char (or ins-point (point-max)))
 336       (setq ref-table (reverse ref-table))
 337       (when sort-only
 338         (setq ref-table
 339               (delq nil (mapcar
 340                          (lambda (x) (and (car x)
 341                                           (not (equal (car x) "fn:"))
 342                                           x))
 343                          ref-table))))
 344       (setq def
 345             (mapconcat
 346              (lambda (x)
 347                (format "[%s] %s" (nth (if sort-only 0 1) x)
 348                        (org-trim (nth 2 x))))
 349              ref-table "\n\n"))
 350       (if ref-table (insert "\n" def "\n\n")))))
 351
 352 (defun org-footnote-delete (&optional label)
 353   "Delete the footnote at point.
 354 This will remove the definition (even multiple definitions if they exist)
 355 and all references of a footnote label."
 356   (catch 'done
 357     (let (x label l beg def-re (nref 0) (ndef 0))
 358       (unless label
 359         (when (setq x (org-footnote-at-reference-p))
 360           (setq label (nth 1 x))
 361           (when (or (not label) (equal "fn:" label))
 362             (delete-region (1+ (match-beginning 0)) (match-end 0))
 363             (message "Anonymous footnote removed")
 364             (throw 'done t)))
 365         (when (and (not label) (setq x (org-footnote-at-definition-p)))
 366           (setq label (nth 1 x)))
 367         (unless label (error "Don't know which footnote to remove")))
 368       (save-excursion
 369         (save-restriction
 370           (goto-char (point-min))
 371           (while (re-search-forward org-footnote-re nil t)
 372             (setq l (or (match-string 1) (match-string 2)))
 373             (when (equal l label)
 374               (delete-region (1+ (match-beginning 0)) (match-end 0))
 375               (incf nref)))
 376           (goto-char (point-min))
 377           (setq def-re (concat "^\\[" (regexp-quote label) "\\]"))
 378           (while (re-search-forward def-re nil t)
 379             (setq beg (match-beginning 0))
 380             (if (re-search-forward "^\\[\\|^[ \t]*$\\|^\\*+ " nil t)
 381                 (goto-char (match-beginning 0))
 382               (goto-char (point-max)))
 383             (delete-region beg (point))
 384             (incf ndef))))
 385       (message "%d definition(s) of and %d reference(s) of footnote %s removed"
 386                ndef nref label))))
 387
 388 (provide 'org-footnote)
 389
 390 ;; arch-tag: 1b5954df-fb5d-4da5-8709-78d944dbfc37
 391 ;;; org-footnote.el ends here