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