lisp/mail/footnote.el

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