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