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