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 2, 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-regexp "¹²³ºª§¶"
 271   "Regexp for Latin-1 footnoting characters.")
 272
 273 (defun Footnote-latin (n)
 274   "Latin-1 footnote style.
 275 Use a range of Latin-1 non-ASCII characters for footnoting."
 276   (string (aref footnote-latin-regexp
 277                 (mod (1- n) (length footnote-latin-regexp)))))
 278
 279 ;;; list of all footnote styles
 280 (defvar footnote-style-alist
 281   `((numeric Footnote-numeric ,footnote-numeric-regexp)
 282     (english-lower Footnote-english-lower ,footnote-english-lower-regexp)
 283     (english-upper Footnote-english-upper ,footnote-english-upper-regexp)
 284     (roman-lower Footnote-roman-lower ,footnote-roman-lower-regexp)
 285     (roman-upper Footnote-roman-upper ,footnote-roman-upper-regexp)
 286     (latin Footnote-latin ,footnote-latin-regexp))
 287   "Styles of footnote tags available.
 288 By default only boring Arabic numbers, English letters and Roman Numerals
 289 are available.
 290 See footnote-han.el, footnote-greek.el and footnote-hebrew.el for more
 291 exciting styles.")
 292
 293 (defcustom footnote-style 'numeric
 294   "*Style used for footnoting.
 295 numeric == 1, 2, 3, ...
 296 english-lower == a, b, c, ...
 297 english-upper == A, B, C, ...
 298 roman-lower == i, ii, iii, iv, v, ...
 299 roman-upper == I, II, III, IV, V, ...
 300 latin == ¹ ² ³ º ª § ¶
 301 See also variables `footnote-start-tag' and `footnote-end-tag'."
 302   :type (cons 'choice (mapcar (lambda (x) (list 'const (car x)))
 303                               footnote-style-alist))
 304   :group 'footnote)
 305
 306 ;;; Style utilities & functions
 307 (defun Footnote-style-p (style)
 308   "Return non-nil if style is a valid style known to footnote-mode."
 309   (assq style footnote-style-alist))
 310
 311 (defun Footnote-index-to-string (index)
 312   "Convert a binary index into a string to display as a footnote.
 313 Conversion is done based upon the current selected style."
 314   (let ((alist (if (Footnote-style-p footnote-style)
 315                    (assq footnote-style footnote-style-alist)
 316                  (nth 0 footnote-style-alist))))
 317     (funcall (nth 1 alist) index)))
 318
 319 (defun Footnote-current-regexp ()
 320   "Return the regexp of the index of the current style."
 321   (concat (nth 2 (or (assq footnote-style footnote-style-alist)
 322                      (nth 0 footnote-style-alist))) "*"))
 323
 324 (defun Footnote-refresh-footnotes (&optional index-regexp)
 325   "Redraw all footnotes.
 326 You must call this or arrange to have this called after changing footnote
 327 styles."
 328   (unless index-regexp
 329     (setq index-regexp (Footnote-current-regexp)))
 330   (save-excursion
 331     ;; Take care of the pointers first
 332     (let ((i 0) locn alist)
 333       (while (setq alist (nth i footnote-pointer-marker-alist))
 334         (setq locn (cdr alist))
 335         (while locn
 336           (goto-char (car locn))
 337           (search-backward footnote-start-tag nil t)
 338           (when (looking-at (concat
 339                              (regexp-quote footnote-start-tag)
 340                              "\\(" index-regexp "\\)"
 341                              (regexp-quote footnote-end-tag)))
 342             (replace-match (concat
 343                             footnote-start-tag
 344                             (Footnote-index-to-string (1+ i))
 345                             footnote-end-tag)
 346                            nil "\\1"))
 347           (setq locn (cdr locn)))
 348         (setq i (1+ i))))
 349
 350     ;; Now take care of the text section
 351     (let ((i 0) alist)
 352       (while (setq alist (nth i footnote-text-marker-alist))
 353         (goto-char (cdr alist))
 354         (when (looking-at (concat
 355                            (regexp-quote footnote-start-tag)
 356                            "\\(" index-regexp "\\)"
 357                            (regexp-quote footnote-end-tag)))
 358           (replace-match (concat
 359                           footnote-start-tag
 360                           (Footnote-index-to-string (1+ i))
 361                           footnote-end-tag)
 362                          nil "\\1"))
 363         (setq i (1+ i))))))
 364
 365 (defun Footnote-assoc-index (key alist)
 366   "Give index of key in alist."
 367   (let ((i 0) (max (length alist)) rc)
 368     (while (and (null rc)
 369                 (< i max))
 370       (when (eq key (car (nth i alist)))
 371         (setq rc i))
 372       (setq i (1+ i)))
 373     rc))
 374
 375 (defun Footnote-cycle-style ()
 376   "Select next defined footnote style."
 377   (interactive)
 378   (let ((old (Footnote-assoc-index footnote-style footnote-style-alist))
 379         (max (length footnote-style-alist))
 380         idx)
 381     (setq idx (1+ old))
 382     (when (>= idx max)
 383       (setq idx 0))
 384     (setq footnote-style (car (nth idx footnote-style-alist)))
 385     (Footnote-refresh-footnotes (nth 2 (nth old footnote-style-alist)))))
 386
 387 (defun Footnote-set-style (&optional style)
 388   "Select a specific style."
 389   (interactive
 390    (list (intern (completing-read
 391                   "Footnote Style: "
 392                   obarray #'Footnote-style-p 'require-match))))
 393   (setq footnote-style style))
 394
 395 ;; Internal functions
 396 (defun Footnote-insert-numbered-footnote (arg &optional mousable)
 397   "Insert numbered footnote at (point)."
 398   (let* ((start (point))
 399          (end (progn
 400                 (insert-before-markers (concat footnote-start-tag
 401                                                (Footnote-index-to-string arg)
 402                                                footnote-end-tag))
 403                 (point))))
 404
 405     (add-text-properties start end
 406                          (list 'footnote-number arg))
 407     (when mousable
 408       (add-text-properties start end
 409                            (list footnote-mouse-highlight t)))))
 410
 411 (defun Footnote-renumber (from to pointer-alist text-alist)
 412   "Renumber a single footnote."
 413   (let* ((posn-list (cdr pointer-alist)))
 414     (setcar pointer-alist to)
 415     (setcar text-alist to)
 416     (while posn-list
 417       (goto-char (car posn-list))
 418       (search-backward footnote-start-tag nil t)
 419       (when (looking-at (format "%s%s%s"
 420                                 (regexp-quote footnote-start-tag)
 421                                 (Footnote-current-regexp)
 422                                 (regexp-quote footnote-end-tag)))
 423         (add-text-properties (match-beginning 0) (match-end 0)
 424                              (list 'footnote-number to))
 425         (replace-match (format "%s%s%s"
 426                                footnote-start-tag
 427                                (Footnote-index-to-string to)
 428                                footnote-end-tag)))
 429       (setq posn-list (cdr posn-list)))
 430     (goto-char (cdr text-alist))
 431     (when (looking-at (format "%s%s%s"
 432                               (regexp-quote footnote-start-tag)
 433                               (Footnote-current-regexp)
 434                               (regexp-quote footnote-end-tag)))
 435       (add-text-properties (match-beginning 0) (match-end 0)
 436                            (list 'footnote-number to))
 437       (replace-match (format "%s%s%s"
 438                              footnote-start-tag
 439                              (Footnote-index-to-string to)
 440                              footnote-end-tag) nil t))))
 441
 442 ;; Not needed?
 443 (defun Footnote-narrow-to-footnotes ()
 444   "Restrict text in buffer to show only text of footnotes."
 445   (interactive) ; testing
 446   (goto-char (point-max))
 447   (when (re-search-backward footnote-signature-separator nil t)
 448     (let ((end (point)))
 449       (when (re-search-backward (concat "^" footnote-section-tag-regexp) nil t)
 450         (narrow-to-region (point) end)))))
 451
 452 (defun Footnote-goto-char-point-max ()
 453   "Move to end of buffer or prior to start of .signature."
 454   (goto-char (point-max))
 455   (or (re-search-backward footnote-signature-separator nil t)
 456       (point)))
 457
 458 (defun Footnote-insert-text-marker (arg locn)
 459   "Insert a marker pointing to footnote arg, at buffer location locn."
 460   (let ((marker (make-marker)))
 461     (unless (assq arg footnote-text-marker-alist)
 462       (set-marker marker locn)
 463       (setq footnote-text-marker-alist
 464             (cons (cons arg marker) footnote-text-marker-alist))
 465       (setq footnote-text-marker-alist
 466             (Footnote-sort footnote-text-marker-alist)))))
 467
 468 (defun Footnote-insert-pointer-marker (arg locn)
 469   "Insert a marker pointing to footnote arg, at buffer location locn."
 470   (let ((marker (make-marker))
 471         alist)
 472     (set-marker marker locn)
 473     (if (setq alist (assq arg footnote-pointer-marker-alist))
 474         (setf alist
 475               (cons marker (cdr alist)))
 476       (setq footnote-pointer-marker-alist
 477             (cons (cons arg (list marker)) footnote-pointer-marker-alist))
 478       (setq footnote-pointer-marker-alist
 479             (Footnote-sort footnote-pointer-marker-alist)))))
 480
 481 (defun Footnote-insert-footnote (arg)
 482   "Insert a footnote numbered arg, at (point)."
 483   (push-mark)
 484   (Footnote-insert-pointer-marker arg (point))
 485   (Footnote-insert-numbered-footnote arg t)
 486   (Footnote-goto-char-point-max)
 487   (if (re-search-backward (concat "^" footnote-section-tag-regexp) nil t)
 488       (save-restriction
 489         (when footnote-narrow-to-footnotes-when-editing
 490           (Footnote-narrow-to-footnotes))
 491         (Footnote-goto-footnote (1- arg)) ; evil, FIXME (less evil now)
 492         ;; (message "Inserting footnote %d" arg)
 493         (unless
 494             (or (eq arg 1)
 495                 (when (re-search-forward
 496                        (if footnote-spaced-footnotes
 497                            "\n\n"
 498                          (concat "\n"
 499                                  (regexp-quote footnote-start-tag)
 500                                  (Footnote-current-regexp)
 501                                  (regexp-quote footnote-end-tag)))
 502                        nil t)
 503                   (unless (beginning-of-line) t))
 504                 (Footnote-goto-char-point-max)
 505                 (re-search-backward (concat "^" footnote-section-tag-regexp) nil t))))
 506     (unless (looking-at "^$")
 507       (insert "\n"))
 508     (when (eobp)
 509       (insert "\n"))
 510     (insert footnote-section-tag "\n"))
 511   (let ((old-point (point)))
 512     (Footnote-insert-numbered-footnote arg nil)
 513     (Footnote-insert-text-marker arg old-point)))
 514
 515 (defun Footnote-sort (list)
 516   (sort list (lambda (e1 e2)
 517                (< (car e1) (car e2)))))
 518
 519 (defun Footnote-text-under-cursor ()
 520   "Return the number of footnote if in footnote text.
 521 Return nil if the cursor is not positioned over the text of
 522 a footnote."
 523   (when (and (let ((old-point (point)))
 524                (save-excursion
 525                  (save-restriction
 526                    (Footnote-narrow-to-footnotes)
 527                    (and (>= old-point (point-min))
 528                         (<= old-point (point-max))))))
 529              (>= (point) (cdar footnote-text-marker-alist)))
 530     (let ((i 1)
 531           alist-txt rc)
 532       (while (and (setq alist-txt (nth i footnote-text-marker-alist))
 533                   (null rc))
 534         (when (< (point) (cdr alist-txt))
 535           (setq rc (car (nth (1- i) footnote-text-marker-alist))))
 536         (setq i (1+ i)))
 537       (when (and (null rc)
 538                  (null alist-txt))
 539         (setq rc (car (nth (1- i) footnote-text-marker-alist))))
 540       rc)))
 541
 542 (defun Footnote-under-cursor ()
 543   "Return the number of the footnote underneath the cursor.
 544 Return nil if the cursor is not over a footnote."
 545   (or (get-text-property (point) 'footnote-number)
 546       (Footnote-text-under-cursor)))
 547
 548 ;;; User functions
 549
 550 (defun Footnote-make-hole ()
 551   (save-excursion
 552     (let ((i 0)
 553           (notes (length footnote-pointer-marker-alist))
 554           alist-ptr alist-txt rc)
 555       (while (< i notes)
 556         (setq alist-ptr (nth i footnote-pointer-marker-alist))
 557         (setq alist-txt (nth i footnote-text-marker-alist))
 558         (when (< (point) (- (cadr alist-ptr) 3))
 559           (unless rc
 560             (setq rc (car alist-ptr)))
 561           (save-excursion
 562             (message "Renumbering from %s to %s"
 563                      (Footnote-index-to-string (car alist-ptr))
 564                      (Footnote-index-to-string
 565                       (1+ (car alist-ptr))))
 566             (Footnote-renumber (car alist-ptr)
 567                                (1+ (car alist-ptr))
 568                                alist-ptr
 569                                alist-txt)))
 570         (setq i (1+ i)))
 571       rc)))
 572
 573 (defun Footnote-add-footnote (&optional arg)
 574   "Add a numbered footnote.
 575 The number the footnote receives is dependent upon the relative location
 576 of any other previously existing footnotes.
 577 If the variable `footnote-narrow-to-footnotes-when-editing' is set,
 578 the buffer is narrowed to the footnote body.  The restriction is removed
 579 by using `Footnote-back-to-message'."
 580   (interactive "*P")
 581   (let (num)
 582     (if footnote-text-marker-alist
 583         (if (< (point) (cadar (last footnote-pointer-marker-alist)))
 584             (setq num (Footnote-make-hole))
 585           (setq num (1+ (caar (last footnote-text-marker-alist)))))
 586       (setq num 1))
 587     (message "Adding footnote %d" num)
 588     (Footnote-insert-footnote num)
 589     (insert-before-markers (make-string footnote-body-tag-spacing ? ))
 590     (let ((opoint (point)))
 591       (save-excursion
 592         (insert-before-markers
 593          (if footnote-spaced-footnotes
 594              "\n\n"
 595            "\n"))
 596         (when footnote-narrow-to-footnotes-when-editing
 597           (Footnote-narrow-to-footnotes)))
 598       ;; Emacs/XEmacs bug?  save-excursion doesn't restore point when using
 599       ;; insert-before-markers.
 600       (goto-char opoint))))
 601
 602 (defun Footnote-delete-footnote (&optional arg)
 603   "Delete a numbered footnote.
 604 With no parameter, delete the footnote under (point).  With arg specified,
 605 delete the footnote with that number."
 606   (interactive "*P")
 607   (unless arg
 608     (setq arg (Footnote-under-cursor)))
 609   (when (and arg
 610              (or (not footnote-prompt-before-deletion)
 611                  (y-or-n-p (format "Really delete footnote %d?" arg))))
 612     (let (alist-ptr alist-txt locn)
 613       (setq alist-ptr (assq arg footnote-pointer-marker-alist))
 614       (setq alist-txt (assq arg footnote-text-marker-alist))
 615       (unless (and alist-ptr alist-txt)
 616         (error "Can't delete footnote %d" arg))
 617       (setq locn (cdr alist-ptr))
 618       (while (car locn)
 619         (save-excursion
 620           (goto-char (car locn))
 621           (let* ((end (point))
 622                  (start (search-backward footnote-start-tag nil t)))
 623             (kill-region start end)))
 624         (setq locn (cdr locn)))
 625       (save-excursion
 626         (goto-char (cdr alist-txt))
 627         (kill-region (point) (search-forward "\n\n" nil t)))
 628       (setq footnote-pointer-marker-alist
 629             (delq alist-ptr footnote-pointer-marker-alist))
 630       (setq footnote-text-marker-alist
 631             (delq alist-txt footnote-text-marker-alist))
 632       (Footnote-renumber-footnotes)
 633       (when (and (null footnote-text-marker-alist)
 634                  (null footnote-pointer-marker-alist))
 635         (save-excursion
 636           (let* ((end (Footnote-goto-char-point-max))
 637                  (start (1- (re-search-backward
 638                              (concat "^" footnote-section-tag-regexp)
 639                              nil t))))
 640             (forward-line -1)
 641             (when (looking-at "\n")
 642               (kill-line))
 643             (kill-region start (if (< end (point-max))
 644                                    end
 645                                  (point-max)))))))))
 646
 647 (defun Footnote-renumber-footnotes (&optional arg)
 648   "Renumber footnotes, starting from 1."
 649   (interactive "*P")
 650   (save-excursion
 651     (let ((i 0)
 652           (notes (length footnote-pointer-marker-alist))
 653           alist-ptr alist-txt)
 654       (while (< i notes)
 655         (setq alist-ptr (nth i footnote-pointer-marker-alist))
 656         (setq alist-txt (nth i footnote-text-marker-alist))
 657         (unless (eq (1+ i) (car alist-ptr))
 658           (Footnote-renumber (car alist-ptr) (1+ i) alist-ptr alist-txt))
 659         (setq i (1+ i))))))
 660
 661 (defun Footnote-goto-footnote (&optional arg)
 662   "Jump to the text of a footnote.
 663 With no parameter, jump to the text of the footnote under (point).  With arg
 664 specified, jump to the text of that footnote."
 665   (interactive "P")
 666   (let (footnote)
 667     (if arg
 668         (setq footnote (assq arg footnote-text-marker-alist))
 669       (when (setq arg (Footnote-under-cursor))
 670         (setq footnote (assq arg footnote-text-marker-alist))))
 671     (if footnote
 672         (goto-char (cdr footnote))
 673       (if (eq arg 0)
 674           (progn
 675             (goto-char (point-max))
 676             (re-search-backward (concat "^" footnote-section-tag-regexp))
 677             (forward-line 1))
 678         (error "I don't see a footnote here")))))
 679
 680 (defun Footnote-back-to-message (&optional arg)
 681   "Move cursor back to footnote referent.
 682 If the cursor is not over the text of a footnote, point is not changed.
 683 If the buffer was narrowed due to `footnote-narrow-to-footnotes-when-editing'
 684 being set it is automatically widened."
 685   (interactive "P")
 686   (let ((note (Footnote-text-under-cursor)))
 687     (when note
 688       (when footnote-narrow-to-footnotes-when-editing
 689         (widen))
 690       (goto-char (cadr (assq note footnote-pointer-marker-alist))))))
 691
 692 (defvar footnote-mode-map nil
 693   "Keymap used for footnote minor mode.")
 694
 695 ;; Set up our keys
 696 (unless footnote-mode-map
 697   (setq footnote-mode-map (make-sparse-keymap))
 698   (define-key footnote-mode-map "a" 'Footnote-add-footnote)
 699   (define-key footnote-mode-map "b" 'Footnote-back-to-message)
 700   (define-key footnote-mode-map "c" 'Footnote-cycle-style)
 701   (define-key footnote-mode-map "d" 'Footnote-delete-footnote)
 702   (define-key footnote-mode-map "g" 'Footnote-goto-footnote)
 703   (define-key footnote-mode-map "r" 'Footnote-renumber-footnotes)
 704   (define-key footnote-mode-map "s" 'Footnote-set-style))
 705
 706 (defvar footnote-minor-mode-map nil
 707   "Keymap used for binding footnote minor mode.")
 708
 709 (unless footnote-minor-mode-map
 710   (define-key global-map footnote-prefix footnote-mode-map))
 711
 712 ;;;###autoload
 713 (defun footnote-mode (&optional arg)
 714   "Toggle footnote minor mode.
 715 \\<message-mode-map>
 716 key             binding
 717 ---             -------
 718
 719 \\[Footnote-renumber-footnotes]         Footnote-renumber-footnotes
 720 \\[Footnote-goto-footnote]              Footnote-goto-footnote
 721 \\[Footnote-delete-footnote]            Footnote-delete-footnote
 722 \\[Footnote-cycle-style]                Footnote-cycle-style
 723 \\[Footnote-back-to-message]            Footnote-back-to-message
 724 \\[Footnote-add-footnote]               Footnote-add-footnote
 725 "
 726   (interactive "*P")
 727   ;; (filladapt-mode t)
 728   (setq footnote-mode
 729         (if (null arg) (not footnote-mode)
 730           (> (prefix-numeric-value arg) 0)))
 731   (when footnote-mode
 732     ;; (Footnote-setup-keybindings)
 733     (make-local-variable 'footnote-style)
 734     (if (fboundp 'force-mode-line-update)
 735         (force-mode-line-update)
 736       (set-buffer-modified-p (buffer-modified-p)))
 737
 738     (when (boundp 'filladapt-token-table)
 739       ;; add tokens to filladapt to match footnotes
 740       ;; 1] xxxxxxxxxxx x x x or [1] x x x x x x x
 741       ;;    xxx x xx xxx xxxx        x x x xxxxxxxxxx
 742       (let ((bullet-regexp (concat (regexp-quote footnote-start-tag)
 743                                    "?[0-9a-zA-Z]+"
 744                                    (regexp-quote footnote-end-tag)
 745                                    "[ \t]")))
 746         (unless (assoc bullet-regexp filladapt-token-table)
 747           (setq filladapt-token-table
 748                 (append filladapt-token-table
 749                         (list (list bullet-regexp 'bullet)))))))
 750
 751     (run-hooks 'footnote-mode-hook)))
 752
 753 (unless (assq 'footnote-mode minor-mode-alist)
 754   (setq minor-mode-alist
 755         (cons '(footnote-mode footnote-mode-line-string)
 756               minor-mode-alist)))
 757
 758 (provide 'footnote)
 759
 760 ;;; arch-tag: 9bcfb6d7-2161-4caf-8793-700f62400398
 761 ;;; footnote.el ends here