lisp/mail/footnote.el

   1 ;;; footnote.el --- footnote support for message mode  -*- coding: iso-latin-1;-*-
   2
   3 ;; Copyright (C) 1997, 2000, 2002, 2003, 2004,
   4 ;;   2005, 2006 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                 (goto-char (point-max)))))
 505     (unless (looking-at "^$")
 506       (insert "\n"))
 507     (when (eobp)
 508       (insert "\n"))
 509     (insert footnote-section-tag "\n"))
 510   (let ((old-point (point)))
 511     (Footnote-insert-numbered-footnote arg nil)
 512     (Footnote-insert-text-marker arg old-point)))
 513
 514 (defun Footnote-sort (list)
 515   (sort list (lambda (e1 e2)
 516                (< (car e1) (car e2)))))
 517
 518 (defun Footnote-text-under-cursor ()
 519   "Return the number of footnote if in footnote text.
 520 Return nil if the cursor is not positioned over the text of
 521 a footnote."
 522   (when (and (let ((old-point (point)))
 523                (save-excursion
 524                  (save-restriction
 525                    (Footnote-narrow-to-footnotes)
 526                    (and (>= old-point (point-min))
 527                         (<= old-point (point-max))))))
 528              (>= (point) (cdar footnote-text-marker-alist)))
 529     (let ((i 1)
 530           alist-txt rc)
 531       (while (and (setq alist-txt (nth i footnote-text-marker-alist))
 532                   (null rc))
 533         (when (< (point) (cdr alist-txt))
 534           (setq rc (car (nth (1- i) footnote-text-marker-alist))))
 535         (setq i (1+ i)))
 536       (when (and (null rc)
 537                  (null alist-txt))
 538         (setq rc (car (nth (1- i) footnote-text-marker-alist))))
 539       rc)))
 540
 541 (defun Footnote-under-cursor ()
 542   "Return the number of the footnote underneath the cursor.
 543 Return nil if the cursor is not over a footnote."
 544   (or (get-text-property (point) 'footnote-number)
 545       (Footnote-text-under-cursor)))
 546
 547 ;;; User functions
 548
 549 (defun Footnote-make-hole ()
 550   (save-excursion
 551     (let ((i 0)
 552           (notes (length footnote-pointer-marker-alist))
 553           alist-ptr alist-txt rc)
 554       (while (< i notes)
 555         (setq alist-ptr (nth i footnote-pointer-marker-alist))
 556         (setq alist-txt (nth i footnote-text-marker-alist))
 557         (when (< (point) (- (cadr alist-ptr) 3))
 558           (unless rc
 559             (setq rc (car alist-ptr)))
 560           (save-excursion
 561             (message "Renumbering from %s to %s"
 562                      (Footnote-index-to-string (car alist-ptr))
 563                      (Footnote-index-to-string
 564                       (1+ (car alist-ptr))))
 565             (Footnote-renumber (car alist-ptr)
 566                                (1+ (car alist-ptr))
 567                                alist-ptr
 568                                alist-txt)))
 569         (setq i (1+ i)))
 570       rc)))
 571
 572 (defun Footnote-add-footnote (&optional arg)
 573   "Add a numbered footnote.
 574 The number the footnote receives is dependent upon the relative location
 575 of any other previously existing footnotes.
 576 If the variable `footnote-narrow-to-footnotes-when-editing' is set,
 577 the buffer is narrowed to the footnote body.  The restriction is removed
 578 by using `Footnote-back-to-message'."
 579   (interactive "*P")
 580   (let (num)
 581     (if footnote-text-marker-alist
 582         (if (< (point) (cadar (last footnote-pointer-marker-alist)))
 583             (setq num (Footnote-make-hole))
 584           (setq num (1+ (caar (last footnote-text-marker-alist)))))
 585       (setq num 1))
 586     (message "Adding footnote %d" num)
 587     (Footnote-insert-footnote num)
 588     (insert-before-markers (make-string footnote-body-tag-spacing ? ))
 589     (let ((opoint (point)))
 590       (save-excursion
 591         (insert-before-markers
 592          (if footnote-spaced-footnotes
 593              "\n\n"
 594            "\n"))
 595         (when footnote-narrow-to-footnotes-when-editing
 596           (Footnote-narrow-to-footnotes)))
 597       ;; Emacs/XEmacs bug?  save-excursion doesn't restore point when using
 598       ;; insert-before-markers.
 599       (goto-char opoint))))
 600
 601 (defun Footnote-delete-footnote (&optional arg)
 602   "Delete a numbered footnote.
 603 With no parameter, delete the footnote under (point).  With arg specified,
 604 delete the footnote with that number."
 605   (interactive "*P")
 606   (unless arg
 607     (setq arg (Footnote-under-cursor)))
 608   (when (and arg
 609              (or (not footnote-prompt-before-deletion)
 610                  (y-or-n-p (format "Really delete footnote %d?" arg))))
 611     (let (alist-ptr alist-txt locn)
 612       (setq alist-ptr (assq arg footnote-pointer-marker-alist))
 613       (setq alist-txt (assq arg footnote-text-marker-alist))
 614       (unless (and alist-ptr alist-txt)
 615         (error "Can't delete footnote %d" arg))
 616       (setq locn (cdr alist-ptr))
 617       (while (car locn)
 618         (save-excursion
 619           (goto-char (car locn))
 620           (let* ((end (point))
 621                  (start (search-backward footnote-start-tag nil t)))
 622             (kill-region start end)))
 623         (setq locn (cdr locn)))
 624       (save-excursion
 625         (goto-char (cdr alist-txt))
 626         (kill-region (point) (search-forward "\n\n" nil t)))
 627       (setq footnote-pointer-marker-alist
 628             (delq alist-ptr footnote-pointer-marker-alist))
 629       (setq footnote-text-marker-alist
 630             (delq alist-txt footnote-text-marker-alist))
 631       (Footnote-renumber-footnotes)
 632       (when (and (null footnote-text-marker-alist)
 633                  (null footnote-pointer-marker-alist))
 634         (save-excursion
 635           (let* ((end (Footnote-goto-char-point-max))
 636                  (start (1- (re-search-backward
 637                              (concat "^" footnote-section-tag-regexp)
 638                              nil t))))
 639             (forward-line -1)
 640             (when (looking-at "\n")
 641               (kill-line))
 642             (kill-region start (if (< end (point-max))
 643                                    end
 644                                  (point-max)))))))))
 645
 646 (defun Footnote-renumber-footnotes (&optional arg)
 647   "Renumber footnotes, starting from 1."
 648   (interactive "*P")
 649   (save-excursion
 650     (let ((i 0)
 651           (notes (length footnote-pointer-marker-alist))
 652           alist-ptr alist-txt)
 653       (while (< i notes)
 654         (setq alist-ptr (nth i footnote-pointer-marker-alist))
 655         (setq alist-txt (nth i footnote-text-marker-alist))
 656         (unless (eq (1+ i) (car alist-ptr))
 657           (Footnote-renumber (car alist-ptr) (1+ i) alist-ptr alist-txt))
 658         (setq i (1+ i))))))
 659
 660 (defun Footnote-goto-footnote (&optional arg)
 661   "Jump to the text of a footnote.
 662 With no parameter, jump to the text of the footnote under (point).  With arg
 663 specified, jump to the text of that footnote."
 664   (interactive "P")
 665   (let (footnote)
 666     (if arg
 667         (setq footnote (assq arg footnote-text-marker-alist))
 668       (when (setq arg (Footnote-under-cursor))
 669         (setq footnote (assq arg footnote-text-marker-alist))))
 670     (if footnote
 671         (goto-char (cdr footnote))
 672       (if (eq arg 0)
 673           (progn
 674             (goto-char (point-max))
 675             (re-search-backward (concat "^" footnote-section-tag-regexp))
 676             (forward-line 1))
 677         (error "I don't see a footnote here")))))
 678
 679 (defun Footnote-back-to-message (&optional arg)
 680   "Move cursor back to footnote referent.
 681 If the cursor is not over the text of a footnote, point is not changed.
 682 If the buffer was narrowed due to `footnote-narrow-to-footnotes-when-editing'
 683 being set it is automatically widened."
 684   (interactive "P")
 685   (let ((note (Footnote-text-under-cursor)))
 686     (when note
 687       (when footnote-narrow-to-footnotes-when-editing
 688         (widen))
 689       (goto-char (cadr (assq note footnote-pointer-marker-alist))))))
 690
 691 (defvar footnote-mode-map nil
 692   "Keymap used for footnote minor mode.")
 693
 694 ;; Set up our keys
 695 (unless footnote-mode-map
 696   (setq footnote-mode-map (make-sparse-keymap))
 697   (define-key footnote-mode-map "a" 'Footnote-add-footnote)
 698   (define-key footnote-mode-map "b" 'Footnote-back-to-message)
 699   (define-key footnote-mode-map "c" 'Footnote-cycle-style)
 700   (define-key footnote-mode-map "d" 'Footnote-delete-footnote)
 701   (define-key footnote-mode-map "g" 'Footnote-goto-footnote)
 702   (define-key footnote-mode-map "r" 'Footnote-renumber-footnotes)
 703   (define-key footnote-mode-map "s" 'Footnote-set-style))
 704
 705 (defvar footnote-minor-mode-map nil
 706   "Keymap used for binding footnote minor mode.")
 707
 708 (unless footnote-minor-mode-map
 709   (define-key global-map footnote-prefix footnote-mode-map))
 710
 711 ;;;###autoload
 712 (defun footnote-mode (&optional arg)
 713   "Toggle footnote minor mode.
 714 \\<message-mode-map>
 715 key             binding
 716 ---             -------
 717
 718 \\[Footnote-renumber-footnotes]         Footnote-renumber-footnotes
 719 \\[Footnote-goto-footnote]              Footnote-goto-footnote
 720 \\[Footnote-delete-footnote]            Footnote-delete-footnote
 721 \\[Footnote-cycle-style]                Footnote-cycle-style
 722 \\[Footnote-back-to-message]            Footnote-back-to-message
 723 \\[Footnote-add-footnote]               Footnote-add-footnote
 724 "
 725   (interactive "*P")
 726   ;; (filladapt-mode t)
 727   (setq footnote-mode
 728         (if (null arg) (not footnote-mode)
 729           (> (prefix-numeric-value arg) 0)))
 730   (when footnote-mode
 731     ;; (Footnote-setup-keybindings)
 732     (make-local-variable 'footnote-style)
 733     (if (fboundp 'force-mode-line-update)
 734         (force-mode-line-update)
 735       (set-buffer-modified-p (buffer-modified-p)))
 736
 737     (when (boundp 'filladapt-token-table)
 738       ;; add tokens to filladapt to match footnotes
 739       ;; 1] xxxxxxxxxxx x x x or [1] x x x x x x x
 740       ;;    xxx x xx xxx xxxx        x x x xxxxxxxxxx
 741       (let ((bullet-regexp (concat (regexp-quote footnote-start-tag)
 742                                    "?[0-9a-zA-Z]+"
 743                                    (regexp-quote footnote-end-tag)
 744                                    "[ \t]")))
 745         (unless (assoc bullet-regexp filladapt-token-table)
 746           (setq filladapt-token-table
 747                 (append filladapt-token-table
 748                         (list (list bullet-regexp 'bullet)))))))
 749
 750     (run-hooks 'footnote-mode-hook)))
 751
 752 (unless (assq 'footnote-mode minor-mode-alist)
 753   (setq minor-mode-alist
 754         (cons '(footnote-mode footnote-mode-line-string)
 755               minor-mode-alist)))
 756
 757 (provide 'footnote)
 758
 759 ;;; arch-tag: 9bcfb6d7-2161-4caf-8793-700f62400398
 760 ;;; footnote.el ends here