lisp/mail/footnote.el

   1 ;;; footnote.el --- footnote support for message mode  -*- coding: iso-latin-1;-*-
   2
   3 ;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007 Free Software Foundation, Inc.
   5
   6 ;; Author: Steven L Baur <steve@xemacs.org>
   7 ;; Keywords: mail, news
   8 ;; Version: 0.19
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 3, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; 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; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
  25 ;; MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; This file provides footnote[1] support for message-mode in emacsen.
  30 ;; footnote-mode is implemented as a minor mode.
  31
  32 ;; [1] Footnotes look something like this.  Along with some decorative
  33 ;; stuff.
  34
  35 ;; TODO:
  36 ;; Reasonable Undo support.
  37 ;; more language styles.
  38
  39 ;;; Code:
  40
  41 (eval-when-compile
  42   (require 'cl)
  43   (defvar filladapt-token-table))
  44
  45 (defgroup footnote nil
  46   "Support for footnotes in mail and news messages."
  47   :version "21.1"
  48   :group 'message)
  49
  50 (defcustom footnote-mode-line-string " FN"
  51   "*String to display in modes section of the mode-line."
  52   :group 'footnote)
  53
  54 (defcustom footnote-mode-hook nil
  55   "*Hook functions run when footnote-mode is activated."
  56   :type 'hook
  57   :group 'footnote)
  58
  59 (defcustom footnote-narrow-to-footnotes-when-editing nil
  60   "*If set, narrow to footnote text body while editing a footnote."
  61   :type 'boolean
  62   :group 'footnote)
  63
  64 (defcustom footnote-prompt-before-deletion t
  65   "*If set, prompt before deleting a footnote.
  66 There is currently no way to undo deletions."
  67   :type 'boolean
  68   :group 'footnote)
  69
  70 (defcustom footnote-spaced-footnotes t
  71   "If set true it will put a blank line between each footnote.
  72 If nil, no blank line will be inserted."
  73   :type 'boolean
  74   :group 'footnote)
  75
  76 (defcustom footnote-use-message-mode t
  77   "*If non-nil assume Footnoting will be done in message-mode."
  78   :type 'boolean
  79   :group 'footnote)
  80
  81 (defcustom footnote-body-tag-spacing 2
  82   "*Number of blanks separating a footnote body tag and its text."
  83   :type 'integer
  84   :group 'footnote)
  85
  86 (defvar footnote-prefix [(control ?c) ?!]
  87   "*When not using message mode, the prefix to bind in `mode-specific-map'")
  88
  89 ;;; Interface variables that probably shouldn't be changed
  90
  91 (defcustom footnote-section-tag "Footnotes: "
  92   "*Tag inserted at beginning of footnote section."
  93   :version "22.1"
  94   :type 'string
  95   :group 'footnote)
  96
  97 (defcustom footnote-section-tag-regexp "Footnotes\\(\\[.\\]\\)?: "
  98   "*Regexp which indicates the start of a footnote section.
  99 See also `footnote-section-tag'."
 100   :type 'regexp
 101   :group 'footnote)
 102
 103 ;; The following three should be consumed by footnote styles.
 104 (defcustom footnote-start-tag "["
 105   "*String used to denote start of numbered footnote."
 106   :type 'string
 107   :group 'footnote)
 108
 109 (defcustom footnote-end-tag "]"
 110   "*String used to denote end of numbered footnote."
 111   :type 'string
 112   :group 'footnote)
 113
 114 (defvar footnote-signature-separator (if (boundp 'message-signature-separator)
 115                                          message-signature-separator
 116                                        "^-- $")
 117   "*String used to recognize .signatures.")
 118
 119 ;;; Private variables
 120
 121 (defvar footnote-style-number nil
 122   "Footnote style represented as an index into footnote-style-alist.")
 123 (make-variable-buffer-local 'footnote-style-number)
 124
 125 (defvar footnote-text-marker-alist nil
 126   "List of markers pointing to text of footnotes in message buffer.")
 127 (make-variable-buffer-local 'footnote-text-marker-alist)
 128
 129 (defvar footnote-pointer-marker-alist nil
 130   "List of markers pointing to footnote pointers in message buffer.")
 131 (make-variable-buffer-local 'footnote-pointer-marker-alist)
 132
 133 (defvar footnote-mouse-highlight 'highlight
 134   "Text property name to enable mouse over highlight.")
 135
 136 (defvar footnote-mode nil
 137   "Variable indicating whether footnote minor mode is active.")
 138 (make-variable-buffer-local 'footnote-mode)
 139
 140 ;;; Default styles
 141 ;;; NUMERIC
 142 (defconst footnote-numeric-regexp "[0-9]+"
 143   "Regexp for digits.")
 144
 145 (defun Footnote-numeric (n)
 146   "Numeric footnote style.
 147 Use Arabic numerals for footnoting."
 148   (int-to-string n))
 149
 150 ;;; ENGLISH UPPER
 151 (defconst footnote-english-upper "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 152   "Upper case English alphabet.")
 153
 154 (defconst footnote-english-upper-regexp "[A-Z]+"
 155   "Regexp for upper case English alphabet.")
 156
 157 (defun Footnote-english-upper (n)
 158   "Upper case English footnoting.
 159 Wrapping around the alphabet implies successive repetitions of letters."
 160   (let* ((ltr (mod (1- n) (length footnote-english-upper)))
 161          (rep (/ (1- n) (length footnote-english-upper)))
 162          (chr (char-to-string (aref footnote-english-upper ltr)))
 163          rc)
 164     (while (>= rep 0)
 165       (setq rc (concat rc chr))
 166       (setq rep (1- rep)))
 167     rc))
 168
 169 ;;; ENGLISH LOWER
 170 (defconst footnote-english-lower "abcdefghijklmnopqrstuvwxyz"
 171   "Lower case English alphabet.")
 172
 173 (defconst footnote-english-lower-regexp "[a-z]+"
 174   "Regexp of lower case English alphabet.")
 175
 176 (defun Footnote-english-lower (n)
 177   "Lower case English footnoting.
 178 Wrapping around the alphabet implies successive repetitions of letters."
 179   (let* ((ltr (mod (1- n) (length footnote-english-lower)))
 180          (rep (/ (1- n) (length footnote-english-lower)))
 181          (chr (char-to-string (aref footnote-english-lower ltr)))
 182          rc)
 183     (while (>= rep 0)
 184       (setq rc (concat rc chr))
 185       (setq rep (1- rep)))
 186     rc))
 187
 188 ;;; ROMAN LOWER
 189 (defconst footnote-roman-lower-list
 190   '((1 . "i") (5 . "v") (10 . "x")
 191     (50 . "l") (100 . "c") (500 . "d") (1000 . "m"))
 192   "List of roman numerals with their values.")
 193
 194 (defconst footnote-roman-lower-regexp "[ivxlcdm]+"
 195   "Regexp of roman numerals.")
 196
 197 (defun Footnote-roman-lower (n)
 198   "Generic Roman number footnoting."
 199   (Footnote-roman-common n footnote-roman-lower-list))
 200
 201 ;;; ROMAN UPPER
 202 (defconst footnote-roman-upper-list
 203   '((1 . "I") (5 . "V") (10 . "X")
 204     (50 . "L") (100 . "C") (500 . "D") (1000 . "M"))
 205   "List of roman numerals with their values.")
 206
 207 (defconst footnote-roman-upper-regexp "[IVXLCDM]+"
 208   "Regexp of roman numerals.  Not complete")
 209
 210 (defun Footnote-roman-upper (n)
 211   "Generic Roman number footnoting."
 212   (Footnote-roman-common n footnote-roman-upper-list))
 213
 214 (defun Footnote-roman-common (n footnote-roman-list)
 215   "Lower case Roman footnoting."
 216   (let* ((our-list footnote-roman-list)
 217          (rom-lngth (length our-list))
 218          (rom-high 0)
 219          (rom-low 0)
 220          (rom-div -1)
 221          (count-high 0)
 222          (count-low 0))
 223     ;; find surrounding numbers
 224     (while (and (<= count-high (1- rom-lngth))
 225                 (>= n (car (nth count-high our-list))))
 226       ;; (message "Checking %d" (car (nth count-high our-list)))
 227       (setq count-high (1+ count-high)))
 228     (setq rom-high count-high)
 229     (setq rom-low (1- count-high))
 230     ;; find the appropriate divisor (if it exists)
 231     (while (and (= rom-div -1)
 232                 (< count-low rom-high))
 233       (when (or (> n (- (car (nth rom-high our-list))
 234                         (/ (car (nth count-low our-list))
 235                            2)))
 236                 (= n (- (car (nth rom-high our-list))
 237                         (car (nth count-low our-list)))))
 238         (setq rom-div count-low))
 239       ;; (message "Checking %d and %d in div loop" rom-high count-low)
 240       (setq count-low (1+ count-low)))
 241     ;;(message "We now have high: %d, low: %d, div: %d, n: %d"
 242     ;;         rom-high rom-low (if rom-div rom-div -1) n)
 243     (let ((rom-low-pair (nth rom-low our-list))
 244           (rom-high-pair (nth rom-high our-list))
 245           (rom-div-pair (if (not (= rom-div -1)) (nth rom-div our-list) nil)))
 246       ;; (message "pairs are: rom-low: %S, rom-high: %S, rom-div: %S"
 247       ;;          rom-low-pair rom-high-pair rom-div-pair)
 248       (cond
 249        ((< n 0) (error "Footnote-roman-common called with n < 0"))
 250        ((= n 0) "")
 251        ((= n (car rom-low-pair)) (cdr rom-low-pair))
 252        ((= n (car rom-high-pair)) (cdr rom-high-pair))
 253        ((= (car rom-low-pair) (car rom-high-pair))
 254         (concat (cdr rom-low-pair)
 255                 (Footnote-roman-common
 256                  (- n (car rom-low-pair))
 257                  footnote-roman-list)))
 258        ((>= rom-div 0) (concat (cdr rom-div-pair) (cdr rom-high-pair)
 259                                (Footnote-roman-common
 260                                 (- n (- (car rom-high-pair)
 261                                         (car rom-div-pair)))
 262                                 footnote-roman-list)))
 263        (t (concat (cdr rom-low-pair)
 264                   (Footnote-roman-common
 265                    (- n (car rom-low-pair))
 266                    footnote-roman-list)))))))
 267
 268 ;; Latin-1
 269
 270 (defconst footnote-latin-string "¹²³ºª§¶"
 271   "String of Latin-1 footnoting characters.")
 272
 273 ;; Note not [...]+, because this style cycles.
 274 (defconst footnote-latin-regexp (concat "[" footnote-latin-string "]")
 275   "Regexp for Latin-1 footnoting characters.")
 276
 277 (defun Footnote-latin (n)
 278   "Latin-1 footnote style.
 279 Use a range of Latin-1 non-ASCII characters for footnoting."
 280   (string (aref footnote-latin-string
 281                 (mod (1- n) (length footnote-latin-string)))))
 282
 283 ;;; list of all footnote styles
 284 (defvar footnote-style-alist
 285   `((numeric Footnote-numeric ,footnote-numeric-regexp)
 286     (english-lower Footnote-english-lower ,footnote-english-lower-regexp)
 287     (english-upper Footnote-english-upper ,footnote-english-upper-regexp)
 288     (roman-lower Footnote-roman-lower ,footnote-roman-lower-regexp)
 289     (roman-upper Footnote-roman-upper ,footnote-roman-upper-regexp)
 290     (latin Footnote-latin ,footnote-latin-regexp))
 291   "Styles of footnote tags available.
 292 By default only boring Arabic numbers, English letters and Roman Numerals
 293 are available.
 294 See footnote-han.el, footnote-greek.el and footnote-hebrew.el for more
 295 exciting styles.")
 296
 297 (defcustom footnote-style 'numeric
 298   "*Default style used for footnoting.
 299 numeric == 1, 2, 3, ...
 300 english-lower == a, b, c, ...
 301 english-upper == A, B, C, ...
 302 roman-lower == i, ii, iii, iv, v, ...
 303 roman-upper == I, II, III, IV, V, ...
 304 latin == ¹ ² ³ º ª § ¶
 305 See also variables `footnote-start-tag' and `footnote-end-tag'.
 306
 307 Customizing this variable has no effect on buffers already
 308 displaying footnotes.  You can change the style of existing
 309 buffers using the command `Footnote-set-style'."
 310   :type (cons 'choice (mapcar (lambda (x) (list 'const (car x)))
 311                               footnote-style-alist))
 312   :group 'footnote)
 313
 314 ;;; Style utilities & functions
 315 (defun Footnote-style-p (style)
 316   "Return non-nil if style is a valid style known to footnote-mode."
 317   (assq style footnote-style-alist))
 318
 319 (defun Footnote-index-to-string (index)
 320   "Convert a binary index into a string to display as a footnote.
 321 Conversion is done based upon the current selected style."
 322   (let ((alist (if (Footnote-style-p footnote-style)
 323                    (assq footnote-style footnote-style-alist)
 324                  (nth 0 footnote-style-alist))))
 325     (funcall (nth 1 alist) index)))
 326
 327 (defun Footnote-current-regexp ()
 328   "Return the regexp of the index of the current style."
 329   (concat (nth 2 (or (assq footnote-style footnote-style-alist)
 330                      (nth 0 footnote-style-alist))) "*"))
 331
 332 (defun Footnote-refresh-footnotes (&optional index-regexp)
 333   "Redraw all footnotes.
 334 You must call this or arrange to have this called after changing footnote
 335 styles."
 336   (unless index-regexp
 337     (setq index-regexp (Footnote-current-regexp)))
 338   (save-excursion
 339     ;; Take care of the pointers first
 340     (let ((i 0) locn alist)
 341       (while (setq alist (nth i footnote-pointer-marker-alist))
 342         (setq locn (cdr alist))
 343         (while locn
 344           (goto-char (car locn))
 345           (search-backward footnote-start-tag nil t)
 346           (when (looking-at (concat
 347                              (regexp-quote footnote-start-tag)
 348                              "\\(" index-regexp "\\)"
 349                              (regexp-quote footnote-end-tag)))
 350             (replace-match (concat
 351                             footnote-start-tag
 352                             (Footnote-index-to-string (1+ i))
 353                             footnote-end-tag)
 354                            nil "\\1"))
 355           (setq locn (cdr locn)))
 356         (setq i (1+ i))))
 357
 358     ;; Now take care of the text section
 359     (let ((i 0) alist)
 360       (while (setq alist (nth i footnote-text-marker-alist))
 361         (goto-char (cdr alist))
 362         (when (looking-at (concat
 363                            (regexp-quote footnote-start-tag)
 364                            "\\(" index-regexp "\\)"
 365                            (regexp-quote footnote-end-tag)))
 366           (replace-match (concat
 367                           footnote-start-tag
 368                           (Footnote-index-to-string (1+ i))
 369                           footnote-end-tag)
 370                          nil "\\1"))
 371         (setq i (1+ i))))))
 372
 373 (defun Footnote-assoc-index (key alist)
 374   "Give index of key in alist."
 375   (let ((i 0) (max (length alist)) rc)
 376     (while (and (null rc)
 377                 (< i max))
 378       (when (eq key (car (nth i alist)))
 379         (setq rc i))
 380       (setq i (1+ i)))
 381     rc))
 382
 383 (defun Footnote-cycle-style ()
 384   "Select next defined footnote style."
 385   (interactive)
 386   (let ((old (Footnote-assoc-index footnote-style footnote-style-alist))
 387         (max (length footnote-style-alist))
 388         idx)
 389     (setq idx (1+ old))
 390     (when (>= idx max)
 391       (setq idx 0))
 392     (setq footnote-style (car (nth idx footnote-style-alist)))
 393     (Footnote-refresh-footnotes (nth 2 (nth old footnote-style-alist)))))
 394
 395 (defun Footnote-set-style (&optional style)
 396   "Select a specific style."
 397   (interactive
 398    (list (intern (completing-read
 399                   "Footnote Style: "
 400                   obarray #'Footnote-style-p 'require-match))))
 401   (setq footnote-style style))
 402
 403 ;; Internal functions
 404 (defun Footnote-insert-numbered-footnote (arg &optional mousable)
 405   "Insert numbered footnote at (point)."
 406   (let* ((start (point))
 407          (end (progn
 408                 (insert-before-markers (concat footnote-start-tag
 409                                                (Footnote-index-to-string arg)
 410                                                footnote-end-tag))
 411                 (point))))
 412
 413     (add-text-properties start end
 414                          (list 'footnote-number arg))
 415     (when mousable
 416       (add-text-properties start end
 417                            (list footnote-mouse-highlight t)))))
 418
 419 (defun Footnote-renumber (from to pointer-alist text-alist)
 420   "Renumber a single footnote."
 421   (let* ((posn-list (cdr pointer-alist)))
 422     (setcar pointer-alist to)
 423     (setcar text-alist to)
 424     (while posn-list
 425       (goto-char (car posn-list))
 426       (search-backward footnote-start-tag nil t)
 427       (when (looking-at (format "%s%s%s"
 428                                 (regexp-quote footnote-start-tag)
 429                                 (Footnote-current-regexp)
 430                                 (regexp-quote footnote-end-tag)))
 431         (add-text-properties (match-beginning 0) (match-end 0)
 432                              (list 'footnote-number to))
 433         (replace-match (format "%s%s%s"
 434                                footnote-start-tag
 435                                (Footnote-index-to-string to)
 436                                footnote-end-tag)))
 437       (setq posn-list (cdr posn-list)))
 438     (goto-char (cdr text-alist))
 439     (when (looking-at (format "%s%s%s"
 440                               (regexp-quote footnote-start-tag)
 441                               (Footnote-current-regexp)
 442                               (regexp-quote footnote-end-tag)))
 443       (add-text-properties (match-beginning 0) (match-end 0)
 444                            (list 'footnote-number to))
 445       (replace-match (format "%s%s%s"
 446                              footnote-start-tag
 447                              (Footnote-index-to-string to)
 448                              footnote-end-tag) nil t))))
 449
 450 ;; Not needed?
 451 (defun Footnote-narrow-to-footnotes ()
 452   "Restrict text in buffer to show only text of footnotes."
 453   (interactive) ; testing
 454   (goto-char (point-max))
 455   (when (re-search-backward footnote-signature-separator nil t)
 456     (let ((end (point)))
 457       (when (re-search-backward (concat "^" footnote-section-tag-regexp) nil t)
 458         (narrow-to-region (point) end)))))
 459
 460 (defun Footnote-goto-char-point-max ()
 461   "Move to end of buffer or prior to start of .signature."
 462   (goto-char (point-max))
 463   (or (re-search-backward footnote-signature-separator nil t)
 464       (point)))
 465
 466 (defun Footnote-insert-text-marker (arg locn)
 467   "Insert a marker pointing to footnote arg, at buffer location locn."
 468   (let ((marker (make-marker)))
 469     (unless (assq arg footnote-text-marker-alist)
 470       (set-marker marker locn)
 471       (setq footnote-text-marker-alist
 472             (cons (cons arg marker) footnote-text-marker-alist))
 473       (setq footnote-text-marker-alist
 474             (Footnote-sort footnote-text-marker-alist)))))
 475
 476 (defun Footnote-insert-pointer-marker (arg locn)
 477   "Insert a marker pointing to footnote arg, at buffer location locn."
 478   (let ((marker (make-marker))
 479         alist)
 480     (set-marker marker locn)
 481     (if (setq alist (assq arg footnote-pointer-marker-alist))
 482         (setf alist
 483               (cons marker (cdr alist)))
 484       (setq footnote-pointer-marker-alist
 485             (cons (cons arg (list marker)) footnote-pointer-marker-alist))
 486       (setq footnote-pointer-marker-alist
 487             (Footnote-sort footnote-pointer-marker-alist)))))
 488
 489 (defun Footnote-insert-footnote (arg)
 490   "Insert a footnote numbered arg, at (point)."
 491   (push-mark)
 492   (Footnote-insert-pointer-marker arg (point))
 493   (Footnote-insert-numbered-footnote arg t)
 494   (Footnote-goto-char-point-max)
 495   (if (re-search-backward (concat "^" footnote-section-tag-regexp) nil t)
 496       (save-restriction
 497         (when footnote-narrow-to-footnotes-when-editing
 498           (Footnote-narrow-to-footnotes))
 499         (Footnote-goto-footnote (1- arg)) ; evil, FIXME (less evil now)
 500         ;; (message "Inserting footnote %d" arg)
 501         (unless
 502             (or (eq arg 1)
 503                 (when (re-search-forward
 504                        (if footnote-spaced-footnotes
 505                            "\n\n"
 506                          (concat "\n"
 507                                  (regexp-quote footnote-start-tag)
 508                                  (Footnote-current-regexp)
 509                                  (regexp-quote footnote-end-tag)))
 510                        nil t)
 511                   (unless (beginning-of-line) t))
 512                 (Footnote-goto-char-point-max)
 513                 (re-search-backward (concat "^" footnote-section-tag-regexp) nil t))))
 514     (unless (looking-at "^$")
 515       (insert "\n"))
 516     (when (eobp)
 517       (insert "\n"))
 518     (insert footnote-section-tag "\n"))
 519   (let ((old-point (point)))
 520     (Footnote-insert-numbered-footnote arg nil)
 521     (Footnote-insert-text-marker arg old-point)))
 522
 523 (defun Footnote-sort (list)
 524   (sort list (lambda (e1 e2)
 525                (< (car e1) (car e2)))))
 526
 527 (defun Footnote-text-under-cursor ()
 528   "Return the number of footnote if in footnote text.
 529 Return nil if the cursor is not positioned over the text of
 530 a footnote."
 531   (when (and (let ((old-point (point)))
 532                (save-excursion
 533                  (save-restriction
 534                    (Footnote-narrow-to-footnotes)
 535                    (and (>= old-point (point-min))
 536                         (<= old-point (point-max))))))
 537              (>= (point) (cdar footnote-text-marker-alist)))
 538     (let ((i 1)
 539           alist-txt rc)
 540       (while (and (setq alist-txt (nth i footnote-text-marker-alist))
 541                   (null rc))
 542         (when (< (point) (cdr alist-txt))
 543           (setq rc (car (nth (1- i) footnote-text-marker-alist))))
 544         (setq i (1+ i)))
 545       (when (and (null rc)
 546                  (null alist-txt))
 547         (setq rc (car (nth (1- i) footnote-text-marker-alist))))
 548       rc)))
 549
 550 (defun Footnote-under-cursor ()
 551   "Return the number of the footnote underneath the cursor.
 552 Return nil if the cursor is not over a footnote."
 553   (or (get-text-property (point) 'footnote-number)
 554       (Footnote-text-under-cursor)))
 555
 556 ;;; User functions
 557
 558 (defun Footnote-make-hole ()
 559   (save-excursion
 560     (let ((i 0)
 561           (notes (length footnote-pointer-marker-alist))
 562           alist-ptr alist-txt rc)
 563       (while (< i notes)
 564         (setq alist-ptr (nth i footnote-pointer-marker-alist))
 565         (setq alist-txt (nth i footnote-text-marker-alist))
 566         (when (< (point) (- (cadr alist-ptr) 3))
 567           (unless rc
 568             (setq rc (car alist-ptr)))
 569           (save-excursion
 570             (message "Renumbering from %s to %s"
 571                      (Footnote-index-to-string (car alist-ptr))
 572                      (Footnote-index-to-string
 573                       (1+ (car alist-ptr))))
 574             (Footnote-renumber (car alist-ptr)
 575                                (1+ (car alist-ptr))
 576                                alist-ptr
 577                                alist-txt)))
 578         (setq i (1+ i)))
 579       rc)))
 580
 581 (defun Footnote-add-footnote (&optional arg)
 582   "Add a numbered footnote.
 583 The number the footnote receives is dependent upon the relative location
 584 of any other previously existing footnotes.
 585 If the variable `footnote-narrow-to-footnotes-when-editing' is set,
 586 the buffer is narrowed to the footnote body.  The restriction is removed
 587 by using `Footnote-back-to-message'."
 588   (interactive "*P")
 589   (let (num)
 590     (if footnote-text-marker-alist
 591         (if (< (point) (cadar (last footnote-pointer-marker-alist)))
 592             (setq num (Footnote-make-hole))
 593           (setq num (1+ (caar (last footnote-text-marker-alist)))))
 594       (setq num 1))
 595     (message "Adding footnote %d" num)
 596     (Footnote-insert-footnote num)
 597     (insert-before-markers (make-string footnote-body-tag-spacing ? ))
 598     (let ((opoint (point)))
 599       (save-excursion
 600         (insert-before-markers
 601          (if footnote-spaced-footnotes
 602              "\n\n"
 603            "\n"))
 604         (when footnote-narrow-to-footnotes-when-editing
 605           (Footnote-narrow-to-footnotes)))
 606       ;; Emacs/XEmacs bug?  save-excursion doesn't restore point when using
 607       ;; insert-before-markers.
 608       (goto-char opoint))))
 609
 610 (defun Footnote-delete-footnote (&optional arg)
 611   "Delete a numbered footnote.
 612 With no parameter, delete the footnote under (point).  With arg specified,
 613 delete the footnote with that number."
 614   (interactive "*P")
 615   (unless arg
 616     (setq arg (Footnote-under-cursor)))
 617   (when (and arg
 618              (or (not footnote-prompt-before-deletion)
 619                  (y-or-n-p (format "Really delete footnote %d?" arg))))
 620     (let (alist-ptr alist-txt locn)
 621       (setq alist-ptr (assq arg footnote-pointer-marker-alist))
 622       (setq alist-txt (assq arg footnote-text-marker-alist))
 623       (unless (and alist-ptr alist-txt)
 624         (error "Can't delete footnote %d" arg))
 625       (setq locn (cdr alist-ptr))
 626       (while (car locn)
 627         (save-excursion
 628           (goto-char (car locn))
 629           (let* ((end (point))
 630                  (start (search-backward footnote-start-tag nil t)))
 631             (kill-region start end)))
 632         (setq locn (cdr locn)))
 633       (save-excursion
 634         (goto-char (cdr alist-txt))
 635         (kill-region (point) (search-forward "\n\n" nil t)))
 636       (setq footnote-pointer-marker-alist
 637             (delq alist-ptr footnote-pointer-marker-alist))
 638       (setq footnote-text-marker-alist
 639             (delq alist-txt footnote-text-marker-alist))
 640       (Footnote-renumber-footnotes)
 641       (when (and (null footnote-text-marker-alist)
 642                  (null footnote-pointer-marker-alist))
 643         (save-excursion
 644           (let* ((end (Footnote-goto-char-point-max))
 645                  (start (1- (re-search-backward
 646                              (concat "^" footnote-section-tag-regexp)
 647                              nil t))))
 648             (forward-line -1)
 649             (when (looking-at "\n")
 650               (kill-line))
 651             (kill-region start (if (< end (point-max))
 652                                    end
 653                                  (point-max)))))))))
 654
 655 (defun Footnote-renumber-footnotes (&optional arg)
 656   "Renumber footnotes, starting from 1."
 657   (interactive "*P")
 658   (save-excursion
 659     (let ((i 0)
 660           (notes (length footnote-pointer-marker-alist))
 661           alist-ptr alist-txt)
 662       (while (< i notes)
 663         (setq alist-ptr (nth i footnote-pointer-marker-alist))
 664         (setq alist-txt (nth i footnote-text-marker-alist))
 665         (unless (= (1+ i) (car alist-ptr))
 666           (Footnote-renumber (car alist-ptr) (1+ i) alist-ptr alist-txt))
 667         (setq i (1+ i))))))
 668
 669 (defun Footnote-goto-footnote (&optional arg)
 670   "Jump to the text of a footnote.
 671 With no parameter, jump to the text of the footnote under (point).  With arg
 672 specified, jump to the text of that footnote."
 673   (interactive "P")
 674   (let (footnote)
 675     (if arg
 676         (setq footnote (assq arg footnote-text-marker-alist))
 677       (when (setq arg (Footnote-under-cursor))
 678         (setq footnote (assq arg footnote-text-marker-alist))))
 679     (if footnote
 680         (goto-char (cdr footnote))
 681       (if (eq arg 0)
 682           (progn
 683             (goto-char (point-max))
 684             (re-search-backward (concat "^" footnote-section-tag-regexp))
 685             (forward-line 1))
 686         (error "I don't see a footnote here")))))
 687
 688 (defun Footnote-back-to-message (&optional arg)
 689   "Move cursor back to footnote referent.
 690 If the cursor is not over the text of a footnote, point is not changed.
 691 If the buffer was narrowed due to `footnote-narrow-to-footnotes-when-editing'
 692 being set it is automatically widened."
 693   (interactive "P")
 694   (let ((note (Footnote-text-under-cursor)))
 695     (when note
 696       (when footnote-narrow-to-footnotes-when-editing
 697         (widen))
 698       (goto-char (cadr (assq note footnote-pointer-marker-alist))))))
 699
 700 (defvar footnote-mode-map nil
 701   "Keymap used for footnote minor mode.")
 702
 703 ;; Set up our keys
 704 (unless footnote-mode-map
 705   (setq footnote-mode-map (make-sparse-keymap))
 706   (define-key footnote-mode-map "a" 'Footnote-add-footnote)
 707   (define-key footnote-mode-map "b" 'Footnote-back-to-message)
 708   (define-key footnote-mode-map "c" 'Footnote-cycle-style)
 709   (define-key footnote-mode-map "d" 'Footnote-delete-footnote)
 710   (define-key footnote-mode-map "g" 'Footnote-goto-footnote)
 711   (define-key footnote-mode-map "r" 'Footnote-renumber-footnotes)
 712   (define-key footnote-mode-map "s" 'Footnote-set-style))
 713
 714 (defvar footnote-minor-mode-map nil
 715   "Keymap used for binding footnote minor mode.")
 716
 717 (unless footnote-minor-mode-map
 718   (define-key global-map footnote-prefix footnote-mode-map))
 719
 720 ;;;###autoload
 721 (defun footnote-mode (&optional arg)
 722   "Toggle footnote minor mode.
 723 \\<message-mode-map>
 724 key             binding
 725 ---             -------
 726
 727 \\[Footnote-renumber-footnotes]         Footnote-renumber-footnotes
 728 \\[Footnote-goto-footnote]              Footnote-goto-footnote
 729 \\[Footnote-delete-footnote]            Footnote-delete-footnote
 730 \\[Footnote-cycle-style]                Footnote-cycle-style
 731 \\[Footnote-back-to-message]            Footnote-back-to-message
 732 \\[Footnote-add-footnote]               Footnote-add-footnote
 733 "
 734   (interactive "*P")
 735   ;; (filladapt-mode t)
 736   (setq footnote-mode
 737         (if (null arg) (not footnote-mode)
 738           (> (prefix-numeric-value arg) 0)))
 739   (when footnote-mode
 740     ;; (Footnote-setup-keybindings)
 741     (make-local-variable 'footnote-style)
 742     (if (fboundp 'force-mode-line-update)
 743         (force-mode-line-update)
 744       (set-buffer-modified-p (buffer-modified-p)))
 745
 746     (when (boundp 'filladapt-token-table)
 747       ;; add tokens to filladapt to match footnotes
 748       ;; 1] xxxxxxxxxxx x x x or [1] x x x x x x x
 749       ;;    xxx x xx xxx xxxx        x x x xxxxxxxxxx
 750       (let ((bullet-regexp (concat (regexp-quote footnote-start-tag)
 751                                    "?[0-9a-zA-Z]+"
 752                                    (regexp-quote footnote-end-tag)
 753                                    "[ \t]")))
 754         (unless (assoc bullet-regexp filladapt-token-table)
 755           (setq filladapt-token-table
 756                 (append filladapt-token-table
 757                         (list (list bullet-regexp 'bullet)))))))
 758
 759     (run-hooks 'footnote-mode-hook)))
 760
 761 (unless (assq 'footnote-mode minor-mode-alist)
 762   (setq minor-mode-alist
 763         (cons '(footnote-mode footnote-mode-line-string)
 764               minor-mode-alist)))
 765
 766 (provide 'footnote)
 767
 768 ;;; arch-tag: 9bcfb6d7-2161-4caf-8793-700f62400398
 769 ;;; footnote.el ends here