Commit | Line | Data |
---|---|---|
9e2dd53f | 1 | ;;; footnote.el --- footnote support for message mode -*- coding: utf-8;-*- |
55492d86 | 2 | |
acaf905b | 3 | ;; Copyright (C) 1997, 2000-2012 Free Software Foundation, Inc. |
55492d86 DL |
4 | |
5 | ;; Author: Steven L Baur <steve@xemacs.org> | |
6 | ;; Keywords: mail, news | |
7 | ;; Version: 0.19 | |
8 | ||
409f8a3f | 9 | ;; This file is part of GNU Emacs. |
55492d86 | 10 | |
b1fc2b50 GM |
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. | |
55492d86 | 15 | |
b1fc2b50 GM |
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. | |
55492d86 DL |
20 | |
21 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
55492d86 | 23 | |
55492d86 DL |
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 | ||
55492d86 DL |
36 | ;;; Code: |
37 | ||
409f8a3f DL |
38 | (eval-when-compile |
39 | (require 'cl) | |
40 | (defvar filladapt-token-table)) | |
41 | ||
55492d86 DL |
42 | (defgroup footnote nil |
43 | "Support for footnotes in mail and news messages." | |
5404d9b0 | 44 | :version "21.1" |
55492d86 DL |
45 | :group 'message) |
46 | ||
55492d86 | 47 | (defcustom footnote-mode-line-string " FN" |
6a8b4632 | 48 | "String to display in modes section of the mode-line." |
55492d86 DL |
49 | :group 'footnote) |
50 | ||
51 | (defcustom footnote-mode-hook nil | |
6a8b4632 | 52 | "Hook functions run when footnote-mode is activated." |
55492d86 DL |
53 | :type 'hook |
54 | :group 'footnote) | |
55 | ||
56 | (defcustom footnote-narrow-to-footnotes-when-editing nil | |
6a8b4632 | 57 | "If non-nil, narrow to footnote text body while editing a footnote." |
55492d86 DL |
58 | :type 'boolean |
59 | :group 'footnote) | |
60 | ||
61 | (defcustom footnote-prompt-before-deletion t | |
6a8b4632 | 62 | "If non-nil, prompt before deleting a footnote. |
55492d86 DL |
63 | There is currently no way to undo deletions." |
64 | :type 'boolean | |
65 | :group 'footnote) | |
66 | ||
67 | (defcustom footnote-spaced-footnotes t | |
6a8b4632 MR |
68 | "If non-nil, insert an empty line between footnotes. |
69 | Customizing this variable has no effect on buffers already | |
70 | displaying footnotes." | |
55492d86 DL |
71 | :type 'boolean |
72 | :group 'footnote) | |
73 | ||
6a8b4632 MR |
74 | (defcustom footnote-use-message-mode t ; Nowhere used. |
75 | "If non-nil, assume Footnoting will be done in `message-mode'." | |
55492d86 DL |
76 | :type 'boolean |
77 | :group 'footnote) | |
78 | ||
79 | (defcustom footnote-body-tag-spacing 2 | |
6a8b4632 MR |
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." | |
55492d86 DL |
83 | :type 'integer |
84 | :group 'footnote) | |
85 | ||
734db384 SM |
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 | ) | |
55492d86 DL |
94 | |
95 | ;;; Interface variables that probably shouldn't be changed | |
96 | ||
c4dc7971 | 97 | (defcustom footnote-section-tag "Footnotes: " |
6a8b4632 MR |
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." | |
c4dc7971 RS |
103 | :type 'string |
104 | :group 'footnote) | |
55492d86 | 105 | |
5404d9b0 | 106 | (defcustom footnote-section-tag-regexp "Footnotes\\(\\[.\\]\\)?: " |
6a8b4632 MR |
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." | |
5404d9b0 DL |
111 | :type 'regexp |
112 | :group 'footnote) | |
55492d86 DL |
113 | |
114 | ;; The following three should be consumed by footnote styles. | |
5404d9b0 | 115 | (defcustom footnote-start-tag "[" |
6a8b4632 MR |
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." | |
5404d9b0 DL |
119 | :type 'string |
120 | :group 'footnote) | |
55492d86 | 121 | |
5404d9b0 | 122 | (defcustom footnote-end-tag "]" |
6a8b4632 MR |
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." | |
5404d9b0 DL |
126 | :type 'string |
127 | :group 'footnote) | |
55492d86 DL |
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 | ||
55492d86 DL |
151 | ;;; Default styles |
152 | ;;; NUMERIC | |
62b1cb94 | 153 | (defconst footnote-numeric-regexp "[0-9]+" |
55492d86 DL |
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 | ||
62b1cb94 | 165 | (defconst footnote-english-upper-regexp "[A-Z]+" |
55492d86 DL |
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)) | |
a1506d29 | 179 | |
55492d86 DL |
180 | ;;; ENGLISH LOWER |
181 | (defconst footnote-english-lower "abcdefghijklmnopqrstuvwxyz" | |
182 | "Lower case English alphabet.") | |
183 | ||
62b1cb94 | 184 | (defconst footnote-english-lower-regexp "[a-z]+" |
55492d86 DL |
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 | ||
62b1cb94 | 205 | (defconst footnote-roman-lower-regexp "[ivxlcdm]+" |
55492d86 DL |
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 | ||
62b1cb94 | 218 | (defconst footnote-roman-upper-regexp "[IVXLCDM]+" |
55492d86 DL |
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 | ||
5404d9b0 DL |
279 | ;; Latin-1 |
280 | ||
9e2dd53f | 281 | (defconst footnote-latin-string "¹²³ºª§¶" |
dedecfd6 MR |
282 | "String of Latin-1 footnoting characters.") |
283 | ||
62b1cb94 | 284 | ;; Note not [...]+, because this style cycles. |
dedecfd6 | 285 | (defconst footnote-latin-regexp (concat "[" footnote-latin-string "]") |
5404d9b0 DL |
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." | |
dedecfd6 MR |
291 | (string (aref footnote-latin-string |
292 | (mod (1- n) (length footnote-latin-string))))) | |
5404d9b0 | 293 | |
b4044869 LL |
294 | ;; Unicode |
295 | ||
296 | (defconst footnote-unicode-string "⁰¹²³⁴⁵⁶⁷⁸⁹" | |
fe7a3057 | 297 | "String of Unicode footnoting characters.") |
b4044869 LL |
298 | |
299 | (defconst footnote-unicode-regexp (concat "[" footnote-unicode-string "]+") | |
fe7a3057 | 300 | "Regexp for Unicode footnoting characters.") |
b4044869 LL |
301 | |
302 | (defun Footnote-unicode (n) | |
303 | "Unicode footnote style. | |
fe7a3057 | 304 | Use Unicode characters for footnoting." |
b4044869 LL |
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 | ||
55492d86 DL |
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) | |
5404d9b0 | 319 | (roman-upper Footnote-roman-upper ,footnote-roman-upper-regexp) |
b4044869 LL |
320 | (latin Footnote-latin ,footnote-latin-regexp) |
321 | (unicode Footnote-unicode ,footnote-unicode-regexp)) | |
55492d86 DL |
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 | ||
5404d9b0 | 328 | (defcustom footnote-style 'numeric |
6a8b4632 | 329 | "Default style used for footnoting. |
5404d9b0 DL |
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, ... | |
9e2dd53f | 335 | latin == ¹ ² ³ º ª § ¶ |
b4044869 | 336 | unicode == ¹, ², ³, ... |
04cc65dc CY |
337 | See also variables `footnote-start-tag' and `footnote-end-tag'. |
338 | ||
b4044869 LL |
339 | Note: some characters in the unicode style may not show up |
340 | properly if the default font does not contain those characters. | |
341 | ||
04cc65dc | 342 | Customizing this variable has no effect on buffers already |
6a8b4632 MR |
343 | displaying footnotes. To change the style of footnotes in such a |
344 | buffer use the command `Footnote-set-style'." | |
5404d9b0 DL |
345 | :type (cons 'choice (mapcar (lambda (x) (list 'const (car x))) |
346 | footnote-style-alist)) | |
347 | :group 'footnote) | |
348 | ||
55492d86 DL |
349 | ;;; Style utilities & functions |
350 | (defun Footnote-style-p (style) | |
fe7a3057 | 351 | "Return non-nil if style is a valid style known to `footnote-mode'." |
55492d86 DL |
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." | |
c6578117 CY |
357 | (let ((alist (if (Footnote-style-p footnote-style) |
358 | (assq footnote-style footnote-style-alist) | |
55492d86 DL |
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." | |
c6578117 | 364 | (concat (nth 2 (or (assq footnote-style footnote-style-alist) |
f851506c RS |
365 | (nth 0 footnote-style-alist))) |
366 | "*")) | |
55492d86 DL |
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)) | |
6a8b4632 MR |
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")) | |
55492d86 DL |
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) | |
f851506c | 405 | "\\(" index-regexp "+\\)" |
55492d86 | 406 | (regexp-quote footnote-end-tag))) |
6a8b4632 MR |
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")) | |
55492d86 DL |
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) | |
c6578117 | 430 | (let ((old (Footnote-assoc-index footnote-style footnote-style-alist)) |
55492d86 DL |
431 | (max (length footnote-style-alist)) |
432 | idx) | |
433 | (setq idx (1+ old)) | |
434 | (when (>= idx max) | |
435 | (setq idx 0)) | |
c6578117 | 436 | (setq footnote-style (car (nth idx footnote-style-alist))) |
55492d86 DL |
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)))) | |
6a8b4632 MR |
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))))) | |
55492d86 DL |
448 | |
449 | ;; Internal functions | |
450 | (defun Footnote-insert-numbered-footnote (arg &optional mousable) | |
451 | "Insert numbered footnote at (point)." | |
6a8b4632 MR |
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))))) | |
55492d86 DL |
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)) | |
6a8b4632 MR |
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))) | |
55492d86 DL |
478 | (setq posn-list (cdr posn-list))) |
479 | (goto-char (cdr text-alist)) | |
6a8b4632 | 480 | (when (looking-at (concat (regexp-quote footnote-start-tag) |
55492d86 DL |
481 | (Footnote-current-regexp) |
482 | (regexp-quote footnote-end-tag))) | |
6a8b4632 MR |
483 | (replace-match |
484 | (propertize | |
485 | (concat footnote-start-tag | |
486 | (Footnote-index-to-string to) | |
487 | footnote-end-tag) | |
488 | 'footnote-number to))))) | |
55492d86 DL |
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))) | |
6a8b4632 MR |
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)))))) | |
55492d86 DL |
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) | |
6a8b4632 | 512 | "Insert a marker pointing to footnote ARG, at buffer location LOCN." |
55492d86 DL |
513 | (let ((marker (make-marker))) |
514 | (unless (assq arg footnote-text-marker-alist) | |
515 | (set-marker marker locn) | |
516 | (setq footnote-text-marker-alist | |
409f8a3f | 517 | (cons (cons arg marker) footnote-text-marker-alist)) |
55492d86 DL |
518 | (setq footnote-text-marker-alist |
519 | (Footnote-sort footnote-text-marker-alist))))) | |
520 | ||
521 | (defun Footnote-insert-pointer-marker (arg locn) | |
6a8b4632 | 522 | "Insert a marker pointing to footnote ARG, at buffer location LOCN." |
55492d86 DL |
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 | |
409f8a3f | 530 | (cons (cons arg (list marker)) footnote-pointer-marker-alist)) |
55492d86 DL |
531 | (setq footnote-pointer-marker-alist |
532 | (Footnote-sort footnote-pointer-marker-alist))))) | |
533 | ||
534 | (defun Footnote-insert-footnote (arg) | |
6a8b4632 | 535 | "Insert a footnote numbered ARG, at (point)." |
55492d86 DL |
536 | (push-mark) |
537 | (Footnote-insert-pointer-marker arg (point)) | |
538 | (Footnote-insert-numbered-footnote arg t) | |
539 | (Footnote-goto-char-point-max) | |
6a8b4632 MR |
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)))) | |
55492d86 | 545 | (save-restriction |
a1506d29 | 546 | (when footnote-narrow-to-footnotes-when-editing |
55492d86 DL |
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)) | |
df034a3f | 561 | (Footnote-goto-char-point-max) |
6a8b4632 MR |
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))))))) | |
55492d86 DL |
568 | (unless (looking-at "^$") |
569 | (insert "\n")) | |
570 | (when (eobp) | |
571 | (insert "\n")) | |
6a8b4632 MR |
572 | (unless (string-equal footnote-section-tag "") |
573 | (insert footnote-section-tag "\n"))) | |
55492d86 DL |
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. | |
0ff9b955 | 584 | Return nil if the cursor is not positioned over the text of |
55492d86 DL |
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)))))) | |
c0bc6d79 SM |
592 | footnote-text-marker-alist |
593 | (>= (point) (cdar footnote-text-marker-alist))) | |
55492d86 DL |
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. | |
0ff9b955 | 608 | Return nil if the cursor is not over a footnote." |
55492d86 DL |
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 | |
a1506d29 | 626 | (message "Renumbering from %s to %s" |
55492d86 | 627 | (Footnote-index-to-string (car alist-ptr)) |
a1506d29 | 628 | (Footnote-index-to-string |
55492d86 DL |
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 | ||
55492d86 DL |
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. | |
6a8b4632 | 668 | With no parameter, delete the footnote under (point). With ARG specified, |
55492d86 DL |
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)) | |
6a8b4632 MR |
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)))) | |
55492d86 DL |
690 | (setq locn (cdr locn))) |
691 | (save-excursion | |
692 | (goto-char (cdr alist-txt)) | |
6a8b4632 MR |
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)))))) | |
55492d86 DL |
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 | |
6a8b4632 MR |
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)))))))) | |
55492d86 DL |
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)) | |
dedecfd6 | 734 | (unless (= (1+ i) (car alist-ptr)) |
55492d86 DL |
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. | |
6a8b4632 | 740 | With no parameter, jump to the text of the footnote under (point). With ARG |
55492d86 DL |
741 | specified, jump to the text of that footnote." |
742 | (interactive "P") | |
6a8b4632 MR |
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"))))) | |
55492d86 DL |
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") | |
55492d86 DL |
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 | ||
734db384 SM |
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) | |
55492d86 DL |
787 | "Keymap used for binding footnote minor mode.") |
788 | ||
55492d86 | 789 | ;;;###autoload |
734db384 | 790 | (define-minor-mode footnote-mode |
ac6c8639 CY |
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: | |
734db384 SM |
799 | \\{footnote-minor-mode-map}" |
800 | :lighter footnote-mode-line-string | |
801 | :keymap footnote-minor-mode-map | |
55492d86 | 802 | ;; (filladapt-mode t) |
55492d86 DL |
803 | (when footnote-mode |
804 | ;; (Footnote-setup-keybindings) | |
c6578117 | 805 | (make-local-variable 'footnote-style) |
6a8b4632 MR |
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) | |
55492d86 DL |
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 | |
734db384 | 824 | (list (list bullet-regexp 'bullet))))))))) |
55492d86 DL |
825 | |
826 | (provide 'footnote) | |
827 | ||
828 | ;;; footnote.el ends here |