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