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