Skip to content

Commit 3fa9c9f

Browse files
committed
* lisp/mail/footnote.el: Tweak markers convention
Instead of using markers that are sometimes before and sometimes after the [...] and using `insert-before-markers` to make sure those that are are before stay before, always place them before, and make them "move after"so they stay with their [...] without the need for insert-before-markers. (footnote--current-regexp): Add arg to match previous style. Include the start/end "tags" in the regexp. Adjust all callers. (footnote--markers-alist): Change position of POINTERS. (footnote--refresh-footnotes, footnote--renumber) (footnote--make-hole, footnote-delete-footnote) (footnote-back-to-message): Adjust accordingly, mostly by using `looking-at` instead of `looking-back`. (footnote--make-hole): Always return footnote nb to use. (footnote-add-footnote): Simplify call accordingly. * test/lisp/mail/footnote-tests.el: New file.
1 parent e10e314 commit 3fa9c9f

File tree

2 files changed

+84
-55
lines changed

2 files changed

+84
-55
lines changed

lisp/mail/footnote.el

Lines changed: 37 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -165,8 +165,7 @@ left with the first character of footnote text."
165165
Where FN is the footnote number, TEXT is a marker pointing to
166166
the footnote's text, and POINTERS is a list of markers pointing
167167
to the places from which the footnote is referenced.
168-
TEXT points right *before* the [...] and POINTERS point right
169-
*after* the [...].")
168+
Both TEXT and POINTERS points right *before* the [...]")
170169

171170
(defvar footnote-mouse-highlight 'highlight
172171
;; FIXME: This `highlight' property is not currently used.
@@ -436,39 +435,34 @@ Conversion is done based upon the current selected style."
436435
(nth 0 footnote-style-alist))))
437436
(funcall (nth 1 alist) index)))
438437

439-
(defun footnote--current-regexp ()
438+
(defun footnote--current-regexp (&optional index-regexp)
440439
"Return the regexp of the index of the current style."
441-
(let ((regexp (nth 2 (or (assq footnote-style footnote-style-alist)
442-
(nth 0 footnote-style-alist)))))
440+
(let ((regexp (or index-regexp
441+
(nth 2 (or (assq footnote-style footnote-style-alist)
442+
(nth 0 footnote-style-alist))))))
443443
(concat
444+
(regexp-quote footnote-start-tag) "\\("
444445
;; Hack to avoid repetition of repetition.
445446
;; FIXME: I'm not sure the added * makes sense at all; there is
446447
;; always a single number within the footnote-{start,end}-tag pairs.
447-
;; Worse, the code goes on and adds yet another + later on, in
448-
;; footnote-refresh-footnotes, just in case. That makes even less sense.
449-
;; Likely, both the * and the extra + should go away.
450448
(if (string-match "[^\\]\\\\\\{2\\}*[*+?]\\'" regexp)
451449
(substring regexp 0 -1)
452450
regexp)
453-
"*")))
451+
"*\\)" (regexp-quote footnote-end-tag))))
454452

455453
(defun footnote--refresh-footnotes (&optional index-regexp)
456454
"Redraw all footnotes.
457455
You must call this or arrange to have this called after changing
458456
footnote styles."
459-
(let ((fn-regexp (concat
460-
(regexp-quote footnote-start-tag)
461-
"\\(" (or index-regexp (footnote--current-regexp)) "+\\)"
462-
(regexp-quote footnote-end-tag))))
457+
(let ((fn-regexp (footnote--current-regexp index-regexp)))
463458
(save-excursion
464459
(pcase-dolist (`(,fn ,text . ,pointers) footnote--markers-alist)
465460
;; Take care of the pointers first
466461
(dolist (locn pointers)
467462
(goto-char locn)
468463
;; Try to handle the case where `footnote-start-tag' and
469464
;; `footnote-end-tag' are the same string.
470-
(when (looking-back fn-regexp
471-
(line-beginning-position))
465+
(when (looking-at fn-regexp)
472466
(replace-match
473467
(propertize
474468
(concat
@@ -515,7 +509,7 @@ footnote styles."
515509
(let ((string (concat footnote-start-tag
516510
(footnote--index-to-string arg)
517511
footnote-end-tag)))
518-
(insert-before-markers
512+
(insert
519513
(if mousable
520514
(propertize
521515
string 'footnote-number arg footnote-mouse-highlight t)
@@ -524,13 +518,11 @@ footnote styles."
524518
(defun footnote--renumber (to alist-elem)
525519
"Renumber a single footnote."
526520
(unless (equal to (car alist-elem)) ;Nothing to do.
527-
(let* ((fn-regexp (concat (regexp-quote footnote-start-tag)
528-
(footnote--current-regexp)
529-
(regexp-quote footnote-end-tag))))
521+
(let* ((fn-regexp (footnote--current-regexp)))
530522
(setcar alist-elem to)
531523
(dolist (posn (cddr alist-elem))
532524
(goto-char posn)
533-
(when (looking-back fn-regexp (line-beginning-position))
525+
(when (looking-at fn-regexp)
534526
(replace-match
535527
(propertize
536528
(concat footnote-start-tag
@@ -562,7 +554,7 @@ footnote styles."
562554
"Insert a marker pointing to footnote ARG, at buffer location LOCN."
563555
(let ((entry (assq arg footnote--markers-alist)))
564556
(unless (cadr entry)
565-
(let ((marker (copy-marker locn)))
557+
(let ((marker (copy-marker locn t)))
566558
(if entry
567559
(setf (cadr entry) marker)
568560
(push `(,arg ,marker) footnote--markers-alist)
@@ -572,7 +564,7 @@ footnote styles."
572564
(defun footnote--insert-pointer-marker (arg locn)
573565
"Insert a marker pointing to footnote ARG, at buffer location LOCN."
574566
(let ((entry (assq arg footnote--markers-alist))
575-
(marker (copy-marker locn)))
567+
(marker (copy-marker locn t)))
576568
(if entry
577569
(push marker (cddr entry))
578570
(push `(,arg nil ,marker) footnote--markers-alist)
@@ -601,8 +593,9 @@ Presumes we're within the footnote area already."
601593
(defun footnote--insert-footnote (arg)
602594
"Insert a footnote numbered ARG, at (point)."
603595
(push-mark)
604-
(footnote--insert-pointer-marker arg (point))
605-
(footnote--insert-numbered-footnote arg t)
596+
(let ((old-point (point)))
597+
(footnote--insert-numbered-footnote arg t)
598+
(footnote--insert-pointer-marker arg old-point))
606599
(footnote--goto-char-point-max)
607600
(if (footnote--goto-first)
608601
(save-restriction
@@ -615,10 +608,7 @@ Presumes we're within the footnote area already."
615608
(when (re-search-forward
616609
(if footnote-spaced-footnotes
617610
"\n\n"
618-
(concat "\n"
619-
(regexp-quote footnote-start-tag)
620-
(footnote--current-regexp)
621-
(regexp-quote footnote-end-tag)))
611+
(concat "\n" (footnote--current-regexp)))
622612
nil t)
623613
(unless (beginning-of-line) t))
624614
(footnote--goto-char-point-max)
@@ -730,10 +720,12 @@ footnote area, returns `point-max'."
730720
;;; User functions
731721

732722
(defun footnote--make-hole ()
723+
"Make room in the alist for a new footnote at point.
724+
Return the footnote number to use."
733725
(save-excursion
734726
(let (rc)
735727
(dolist (alist-elem footnote--markers-alist)
736-
(when (< (point) (- (cl-caddr alist-elem) 3))
728+
(when (<= (point) (cl-caddr alist-elem))
737729
(unless rc
738730
(setq rc (car alist-elem)))
739731
(save-excursion
@@ -743,7 +735,8 @@ footnote area, returns `point-max'."
743735
(1+ (car alist-elem))))
744736
(footnote--renumber (1+ (car alist-elem))
745737
alist-elem))))
746-
rc)))
738+
(or rc
739+
(1+ (or (caar (last footnote--markers-alist)) 0))))))
747740

748741
(defun footnote-add-footnote ()
749742
"Add a numbered footnote.
@@ -753,27 +746,17 @@ If the variable `footnote-narrow-to-footnotes-when-editing' is set,
753746
the buffer is narrowed to the footnote body. The restriction is removed
754747
by using `footnote-back-to-message'."
755748
(interactive "*")
756-
(let ((num
757-
(if footnote--markers-alist
758-
(let ((last (car (last footnote--markers-alist))))
759-
(if (< (point) (cl-caddr last))
760-
(footnote--make-hole)
761-
(1+ (car last))))
762-
1)))
749+
(let ((num (footnote--make-hole)))
763750
(message "Adding footnote %d" num)
764751
(footnote--insert-footnote num)
765-
(insert-before-markers (make-string footnote-body-tag-spacing ? ))
766-
(let ((opoint (point)))
767-
(save-excursion
768-
(insert-before-markers
769-
(if footnote-spaced-footnotes
770-
"\n\n"
771-
"\n"))
772-
(when footnote-narrow-to-footnotes-when-editing
773-
(footnote--narrow-to-footnotes)))
774-
;; Emacs/XEmacs bug? save-excursion doesn't restore point when using
775-
;; insert-before-markers.
776-
(goto-char opoint))))
752+
(insert (make-string footnote-body-tag-spacing ? ))
753+
(save-excursion
754+
(insert
755+
(if footnote-spaced-footnotes
756+
"\n\n"
757+
"\n"))
758+
(when footnote-narrow-to-footnotes-when-editing
759+
(footnote--narrow-to-footnotes)))))
777760

778761
(defun footnote-delete-footnote (&optional arg)
779762
"Delete a numbered footnote.
@@ -787,14 +770,11 @@ delete the footnote with that number."
787770
(y-or-n-p (format "Really delete footnote %d?" arg))))
788771
(let ((alist-elem (or (assq arg footnote--markers-alist)
789772
(error "Can't delete footnote %d" arg)))
790-
(fn-regexp (concat (regexp-quote footnote-start-tag)
791-
(footnote--current-regexp)
792-
(regexp-quote footnote-end-tag))))
773+
(fn-regexp (footnote--current-regexp)))
793774
(dolist (locn (cddr alist-elem))
794775
(save-excursion
795776
(goto-char locn)
796-
(when (looking-back fn-regexp
797-
(line-beginning-position))
777+
(when (looking-at fn-regexp)
798778
(delete-region (match-beginning 0) (match-end 0)))))
799779
(save-excursion
800780
(goto-char (cadr alist-elem))
@@ -867,7 +847,9 @@ being set it is automatically widened."
867847
(when note
868848
(when footnote-narrow-to-footnotes-when-editing
869849
(widen))
870-
(goto-char (cl-caddr (assq note footnote--markers-alist))))))
850+
(goto-char (cl-caddr (assq note footnote--markers-alist)))
851+
(when (looking-at (footnote--current-regexp))
852+
(goto-char (match-end 0))))))
871853

872854
(defvar footnote-mode-map
873855
(let ((map (make-sparse-keymap)))

test/lisp/mail/footnote-tests.el

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
;;; footnote-tests.el --- Tests for footnote-mode -*- lexical-binding: t; -*-
2+
3+
;; Copyright (C) 2019 Free Software Foundation, Inc.
4+
5+
;; Author: Stefan Monnier <[email protected]>
6+
;; Keywords:
7+
8+
;; This program is free software; you can redistribute it and/or modify
9+
;; it under the terms of the GNU General Public License as published by
10+
;; the Free Software Foundation, either version 3 of the License, or
11+
;; (at your option) any later version.
12+
13+
;; This program is distributed in the hope that it will be useful,
14+
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15+
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16+
;; GNU General Public License for more details.
17+
18+
;; You should have received a copy of the GNU General Public License
19+
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
20+
21+
;;; Commentary:
22+
23+
;;
24+
25+
;;; Code:
26+
27+
(ert-deftest footnote-tests-same-place ()
28+
(with-temp-buffer
29+
(footnote-mode 1)
30+
(insert "hello world")
31+
(beginning-of-line) (forward-word)
32+
(footnote-add-footnote)
33+
(insert "footnote")
34+
(footnote-back-to-message)
35+
(should (equal (buffer-substring (point-min) (point))
36+
"hello[1]"))
37+
(beginning-of-line) (forward-word)
38+
(footnote-add-footnote)
39+
(insert "other footnote")
40+
(footnote-back-to-message)
41+
(should (equal (buffer-substring (point-min) (point))
42+
"hello[1]"))
43+
(should (equal (buffer-substring (point-min) (line-end-position))
44+
"hello[1][2] world"))))
45+
46+
(provide 'footnote-tests)
47+
;;; footnote-tests.el ends here

0 commit comments

Comments
 (0)